home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / bbs / pibterm / pibt3sp4 / sendxmod.pas < prev    next >
Pascal/Delphi Source File  |  1985-08-30  |  25KB  |  678 lines
  1.  
  2. (*----------------------------------------------------------------------*)
  3. (*                Send_Xmodem_File --- Upload file using XMODEM         *)
  4. (*----------------------------------------------------------------------*)
  5.  
  6. PROCEDURE Send_Xmodem_File( Use_CRC : BOOLEAN );
  7.  
  8. (*----------------------------------------------------------------------*)
  9. (*                                                                      *)
  10. (*     Procedure:  Send_Xmodem_File                                     *)
  11. (*                                                                      *)
  12. (*     Purpose:    Uploads file to remote host using XMODEM protocol.   *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Send_Xmodem_File( Use_CRC );                                  *)
  17. (*                                                                      *)
  18. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  19. (*                       of XMODEM; FALSE to use Checksum version.      *)
  20. (*                                                                      *)
  21. (*     Remarks:                                                         *)
  22. (*                                                                      *)
  23. (*        The file's existence should have been already checked         *)
  24. (*        prior to calling this routine.                                *)
  25. (*                                                                      *)
  26. (*        The transmission parameters are automatically set to:         *)
  27. (*                                                                      *)
  28. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  29. (*                                                                      *)
  30. (*        and then they are automatically restored to the previous      *)
  31. (*        values when the transfer is complete.                         *)
  32. (*                                                                      *)
  33. (*     Calls:    KeyPressed                                             *)
  34. (*               Async_Send                                             *)
  35. (*               Async_Receive                                          *)
  36. (*               Compute_Crc                                            *)
  37. (*               Draw_Menu_Frame                                        *)
  38. (*               Save_Screen                                            *)
  39. (*               Restore_Screen                                         *)
  40. (*               Async_Open                                             *)
  41. (*                                                                      *)
  42. (*----------------------------------------------------------------------*)
  43.  
  44.                                    (* If this threshhold value x number *)
  45.                                    (* of bad blocks > number of good    *)
  46.                                    (* blocks, reduce block size to 128  *)
  47. CONST
  48.    Bad_Threshhold = 6;
  49.  
  50. VAR
  51.    Xfile_Byte    : FILE OF BYTE    (* Same as transfer file, file size  *);
  52.    XFile_Handle  : INTEGER         (* File handle for file to transfer  *);
  53.    I             : INTEGER         (* Loop index                        *);
  54.    Tries         : INTEGER         (* # of tries sending current sector *);
  55.    Checksum      : INTEGER         (* Sector checksum                   *);
  56.    Crc           : INTEGER         (* Cyclic redundancy check           *);
  57.    Ch            : INTEGER         (* Character received from COM port  *);
  58.    Sector_Length : INTEGER         (* # chars to send                   *);
  59.    Kbd_Ch        : CHAR            (* Absorbs keyboard characters       *);
  60.    Send_Errors   : INTEGER         (* Counts transfer errors            *);
  61.    Blocks_To_Send: INTEGER         (* Number of blocks to send          *);
  62.    Sector_Count  : INTEGER         (* Sector count -- no wrap at 255    *);
  63.    Transfer_Time : INTEGER         (* Transfer time in seconds          *);
  64.    Starting_Time : INTEGER         (* Starting transfer time            *);
  65.    Trans_Hours   : INTEGER         (* Transfer time -- hours component  *);
  66.    Trans_Minutes : INTEGER         (* Transfer time -- mins. component  *);
  67.    Trans_Seconds : INTEGER         (* Transfer time -- secs. component  *);
  68.    S_Hours       : STRING[2]       (* Hours in character form           *);
  69.    S_Minutes     : STRING[2]       (* Minutes in character form         *);
  70.    S_Seconds     : STRING[2]       (* Seconds in character form         *);
  71.    Time_To_Send  : REAL            (* Time in seconds to transfer file  *);
  72.    Time_Per_Blk  : REAL            (* Time in seconds to transfer block *);
  73.    Effective_Rate: REAL            (* Effective baud rate of transfer   *);
  74.    Start_Time    : REAL            (* Starting time of transfer         *);
  75.    End_Time      : REAL            (* Ending time of transfer           *);
  76.    NRead         : INTEGER         (* Records actually read from file   *);
  77.    EOF_Xfile     : BOOLEAN         (* EOF encountered on file to send   *);
  78.    Tname         : STRING[20]      (* Transfer type                     *);
  79.    Sector_Size1  : INTEGER         (* Sector size + 1                   *);
  80.    Sector_Size2  : INTEGER         (* Sector size + 2                   *);
  81.    Alt_S_Found   : BOOLEAN         (* TRUE if alt_s entered             *);
  82.    Max_Tries     : INTEGER         (* Max. number of retries            *);
  83.    R_Sector_Size : REAL            (* Sector size as reals              *);
  84.    Header_Ch     : CHAR            (* Block header character            *);
  85.    New_Header_Ch : CHAR            (* Revised block header if downshift *);
  86.    Bad_Sectors   : INTEGER         (* Count of bad sectors              *);
  87.    Good_Sectors  : INTEGER         (* Count of good sectors             *);
  88.    ITime         : INTEGER         (* Counter for wait loops            *);
  89.  
  90. (*----------------------------------------------------------------------*)
  91. (*   Update_Xmodem_Send_Display --- Update display of Xmodem sending    *)
  92. (*----------------------------------------------------------------------*)
  93.  
  94. PROCEDURE Update_Xmodem_Send_Display;
  95.  
  96. BEGIN (* Update_Xmodem_Send_Display *)
  97.  
  98.    GoToXY( 26 , 4 );
  99.    WRITE( Sector_Count );
  100.    GoToXY( 26 , 5 );
  101.    WRITE( Send_Errors  );
  102.    GoToXY( 26 , 6 );
  103.    WRITE( TimeString( Time_To_Send ) );
  104.  
  105. END   (* Update_Xmodem_Send_Display *);
  106.  
  107. (*----------------------------------------------------------------------*)
  108. (*         Display_Send_Error --- Display XMODEM sending error          *)
  109. (*----------------------------------------------------------------------*)
  110.  
  111. PROCEDURE Display_Send_Error( Err_Text: AnyStr; Display_Block: BOOLEAN );
  112.  
  113. BEGIN (* Display_Send_Error *)
  114.  
  115.    GoToXY( 26 , 8 );
  116.  
  117.    WRITE(Err_Text);
  118.  
  119.    IF Display_Block THEN
  120.       WRITE( ' at/before block ', MAX( Sector_Count - 1 , 0 ) );
  121.  
  122.    ClrEol;
  123.  
  124. END   (* Display_Send_Error *);
  125.  
  126. (*----------------------------------------------------------------------*)
  127. (*               Check_Keyboard --- Check for keyboard entry            *)
  128. (*----------------------------------------------------------------------*)
  129.  
  130. PROCEDURE Check_Keyboard;
  131.  
  132. BEGIN (* Check_Keyboard *)
  133.  
  134.    IF KeyPressed THEN
  135.       BEGIN
  136.          READ( Kbd, Kbd_Ch );
  137.          IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN
  138.             BEGIN
  139.                READ( Kbd , Kbd_Ch );
  140.                Alt_S_Found := ( ORD( Kbd_Ch ) = Alt_S );
  141.                Stop_Send   := Stop_Send OR Alt_S_Found;
  142.             END;
  143.       END;
  144.  
  145. END   (* Check_Keyboard *);
  146.  
  147. (*----------------------------------------------------------------------*)
  148. (*    Xmodem_Wait_For_Ch --- wait 10 seconds for character to appear    *)
  149. (*----------------------------------------------------------------------*)
  150.  
  151. PROCEDURE Xmodem_Wait_For_Ch( VAR Ch: INTEGER );
  152.  
  153. BEGIN (* Xmodem_Wait_For_Ch *)
  154.  
  155.    ITime := 0;
  156.  
  157.    REPEAT
  158.       ITime := ITime + 1;
  159.       Async_Receive_With_Timeout( One_Second , Ch );
  160.       Check_KeyBoard;
  161.    UNTIL ( Ch <> TimeOut ) OR ( ITime >= Ten_Seconds ) OR Stop_Send;
  162.  
  163. END   (* Xmodem_Wait_For_Ch *);
  164.  
  165. (*----------------------------------------------------------------------*)
  166. (*               Send_Xmodem_Block --- send out Xmodem block            *)
  167. (*----------------------------------------------------------------------*)
  168.  
  169. PROCEDURE Send_Xmodem_Block;
  170.  
  171. VAR
  172.    I     : INTEGER;
  173.    ITime : INTEGER;
  174.  
  175. BEGIN (* Send_Xmodem_Block *)
  176.                                    (* Reset error count to zero         *)
  177.    Tries := 0;
  178.  
  179.    REPEAT
  180.                                    (* Send 1st char of block *)
  181.       Async_Send( Header_Ch );
  182.                                    (* Send block number and complement *)
  183.  
  184.       Async_Send( CHR(       Sector_Number ) );
  185.       Async_Send( CHR( 255 - Sector_Number ) );
  186.  
  187.                                    (* Transmit Sector Data              *)
  188.  
  189.       FOR I := 1 TO Sector_Length DO
  190.          Async_Send( CHR( Sector_Data[ I ] ) );
  191.  
  192.                                    (* Purge receive buffer *)
  193.       Async_Purge_Buffer;
  194.                                    (* Increment count of tries to send  *)
  195.                                    (* for this sector.                  *)
  196.       Tries := Tries + 1;
  197.                                    (* Pick up a character -- should be ACK *)
  198.       Xmodem_Wait_For_Ch( Ch );
  199.                                    (* If CAN, insist on another *)
  200.       IF Ch = CAN THEN
  201.          Xmodem_Wait_For_Ch( Ch );
  202.  
  203.       IF Ch <> ACK THEN
  204.          BEGIN
  205.             Display_Send_Error('No ACK', TRUE);
  206.             Send_Errors := Send_Errors + 1;
  207.          END;
  208.                                    (* Update display *)
  209.       Update_Xmodem_Send_Display;
  210.  
  211.    UNTIL ( Ch = ACK ) OR
  212.          ( Ch = CAN ) OR
  213.          ( Tries > Max_Tries ) OR
  214.          ( Stop_Send );
  215.  
  216. END   (* Send_Xmodem_Block *);
  217.  
  218. (*----------------------------------------------------------------------*)
  219. (*      Send_Telink_Header --- send out special block 0 for Telink      *)
  220. (*----------------------------------------------------------------------*)
  221.  
  222. PROCEDURE Send_Telink_Header;
  223.  
  224. BEGIN (* Send_Telink_Header *)
  225.                                    (* Always send TELINK in Checksum mode *)
  226.    Max_Tries     := 3;
  227.    I             := Sector_Length;
  228.    Sector_Length := 129;
  229.    Header_Ch     := CHR( SYN );
  230.  
  231.    Send_Xmodem_Block;
  232.  
  233.    Sector_Length := I;
  234.    Max_Tries     := 10;
  235.  
  236.    If ( Ch = ACK ) THEN
  237.       BEGIN
  238.          GoToXY( 26 , 8 );
  239.          WRITE('Telink header accepted.');
  240.          ClrEol;
  241.       END
  242.    ELSE
  243.       BEGIN
  244.          GoToXY( 26 , 8 );
  245.          WRITE('Telink header not accepted.');
  246.          ClrEol;
  247.       END
  248.  
  249. END   (* Send_Telink_Header *);
  250.  
  251. (*----------------------------------------------------------------------*)
  252. (*      Send_Ymodem_Header --- send out special block 0 for Ymodem      *)
  253. (*----------------------------------------------------------------------*)
  254.  
  255. PROCEDURE Send_Ymodem_Header;
  256.  
  257. BEGIN (* Send_Ymodem_Header *)
  258.                                    (* Always send short block 0 *)
  259.    Max_Tries     := 3;
  260.    I             := Sector_Length;
  261.    Sector_Length := 130;
  262.    Header_Ch     := CHR( SOH );
  263.  
  264.    Send_Xmodem_Block;
  265.  
  266.    Sector_Length := I;
  267.    Max_Tries     := 10;
  268.  
  269.    If ( Ch = ACK ) THEN
  270.       BEGIN
  271.          GoToXY( 26 , 8 );
  272.          WRITE('Ymodem header accepted.');
  273.          ClrEol;
  274.       END
  275.    ELSE
  276.       BEGIN
  277.          GoToXY( 26 , 8 );
  278.          WRITE('Ymodem header not accepted.');
  279.          ClrEol;
  280.       END
  281.  
  282. END   (* Send_Ymodem_Header *);
  283.  
  284. (*----------------------------------------------------------------------*)
  285. (*                 Cancel_Transfer --- Cancel upload                    *)
  286. (*----------------------------------------------------------------------*)
  287.  
  288. PROCEDURE Cancel_Transfer;
  289.  
  290. BEGIN (* Cancel_Transfer *)
  291.                                    (* Purge reception *)
  292.    Async_Purge_Buffer;
  293.                                    (* Send five cancels, then five *)
  294.                                    (* backspaces.                  *)
  295.    Async_Send( CHR( CAN ) );
  296.    Async_Send( CHR( CAN ) );
  297.    Async_Send( CHR( CAN ) );
  298.    Async_Send( CHR( CAN ) );
  299.    Async_Send( CHR( CAN ) );
  300.  
  301.    Async_Send( CHR( BS  ) );
  302.    Async_Send( CHR( BS  ) );
  303.    Async_Send( CHR( BS  ) );
  304.    Async_Send( CHR( BS  ) );
  305.    Async_Send( CHR( BS  ) );
  306.  
  307. END   (* Cancel_Transfer *);
  308.  
  309. (*----------------------------------------------------------------------*)
  310.  
  311. BEGIN (* Send_Xmodem_File *)
  312.                                    (* Open display window for transfer  *)
  313.    Save_Screen( Saved_Screen );
  314.  
  315.    CASE Transfer_Protocol OF
  316.       Xmodem_Chk   : Tname := 'Xmodem (Checksum)';
  317.       Xmodem_Crc   : Tname := 'Xmodem (CRC)';
  318.       Telink       : Tname := 'Telink';
  319.       Modem7_Chk   : Tname := 'Modem7 (Checksum)';
  320.       Modem7_CRC   : Tname := 'Modem7 (CRC)';
  321.       Ymodem       : Tname := 'Ymodem';
  322.       Ymodem_Batch : Tname := 'Ymodem Batch';
  323.    END (* CASE *);
  324.  
  325.    Draw_Menu_Frame( 15, 10, 78, 19, Menu_Frame_Color,
  326.                     Menu_Text_Color,
  327.                     'Send file ' + FileName + ' using ' + Tname );
  328.  
  329.                                    (* Headings for status information *)
  330.    Window( 16, 11, 77, 18 );
  331.  
  332.    ASSIGN( Xfile_Byte , FileName );
  333.       (*$I-*)
  334.    RESET ( Xfile_Byte );
  335.       (*$I+*)
  336.  
  337.    IF ( Int24Result <> 0 ) THEN
  338.       BEGIN
  339.          WRITE('Cannot open file to send, transfer cancelled.');
  340.          Cancel_Transfer;
  341.          DELAY( One_Second_Delay );
  342.          Restore_Screen( Saved_Screen );
  343.          Reset_Global_Colors;
  344.          EXIT;
  345.       END;
  346.                                    (* Determine sector size             *)
  347.  
  348.    IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN
  349.       Sector_Size := 1024
  350.    ELSE
  351.       Sector_Size := 128;
  352.  
  353.    Sector_Size1 := Sector_Size + 1;
  354.    Sector_Size2 := Sector_Size + 2;
  355.  
  356.    IF Use_Crc THEN
  357.       Sector_Length := Sector_Size2
  358.    ELSE
  359.       Sector_Length := Sector_Size1;
  360.  
  361.                                    (* Number of retries of bad block *)
  362.    Max_Tries        := 20;
  363.                                    (* Figure approx. time for upload *)
  364.  
  365.    Blocks_To_Send := ROUND( ( LongFileSize( Xfile_Byte ) / Sector_Size ) + 0.49 );
  366.    Time_To_Send   := Blocks_To_Send * ( Sector_Size DIV 128 ) *
  367.                                       ( Trans_Time_Val / Baud_Rate );
  368.    Time_Per_Blk   := Time_To_Send / Blocks_To_Send;
  369.  
  370.       (*$I-*)
  371.    CLOSE ( Xfile_Byte );
  372.       (*$I+*)
  373.  
  374.    I := Int24Result;
  375.                                    (* Headings for status information *)
  376.  
  377.    WRITELN(' Blocks to send        : ', Blocks_To_Send);
  378.    WRITELN(' Approx. transfer time : ', TimeString( Time_To_Send ) );
  379.    WRITELN(' ');
  380.    WRITELN(' Sending block         : ');
  381.    WRITELN(' Errors                : ');
  382.    WRITELN(' Time remaining        : ', TimeString( Time_To_Send ) );
  383.    WRITELN(' ');
  384.    WRITE  (' Last status message   : ');
  385.  
  386.                                    (* Open file to send *)
  387.  
  388.    I := Open_File_Handle( FileName, Access_Read_Mode, XFile_Handle );
  389.  
  390.    IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN
  391.       BEGIN
  392.          WRITE('Cannot open file to send, transfer cancelled.');
  393.          Cancel_Transfer;
  394.          DELAY( One_Second_Delay );
  395.          Restore_Screen( Saved_Screen );
  396.          Reset_Global_Colors;
  397.          EXIT;
  398.       END;
  399.  
  400.                                    (* Sector #s start at 1, wrap at 255 *)
  401.    Sector_Number := 0;
  402.    Sector_Count  := 0;
  403.                                    (* No errors yet                     *)
  404.    Send_Errors   := 0;
  405.                                    (* Set TRUE if errors halt transfer  *)
  406.    Stop_Send     := FALSE;
  407.                                    (* Starting time for transfer        *)
  408.    Start_Time    := TimeOfDay;
  409.                                    (* Set EOF on Xfile to FALSE         *)
  410.    EOF_Xfile     := FALSE;
  411.                                    (* Set Alt_S encountered off         *)
  412.    Alt_S_Found   := FALSE;
  413.                                    (* No retries yet                    *)
  414.    Tries         := 0;
  415.                                    (* Get initial character             *)
  416.    GoToXY( 26 , 8 );
  417.    WRITE('Waiting for NAK/C --- ');
  418.    ClrEol;
  419.                                    (* Purge receive buffer *)
  420.    Async_Purge_Buffer;
  421.                                    (* Look for NAK or C    *)
  422.    REPEAT
  423.  
  424.       Xmodem_Wait_For_Ch( Ch );
  425.  
  426.                                    (* If CAN, insist on another *)
  427.       IF Ch = CAN THEN
  428.          Xmodem_Wait_For_Ch( Ch );
  429.  
  430.       Tries := Tries + 1;
  431.  
  432.       Check_KeyBoard;
  433.  
  434.       Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
  435.  
  436.    UNTIL ( Tries > Max_Tries  ) OR
  437.          ( Ch    = NAK        ) OR
  438.          ( Ch    = ORD( 'C' ) ) OR
  439.          ( Ch    = TimeOut    ) OR
  440.          ( Ch    = CAN        ) OR
  441.          Stop_Send;
  442.  
  443.    IF ( Ch    = TimeOut   ) OR
  444.       ( Tries > Max_Tries ) OR
  445.       ( Ch    = CAN       ) THEN
  446.       BEGIN
  447.          GoToXY( 26 , 51 );
  448.          WRITE('Not Received ');
  449.          ClrEol;
  450.          Stop_Send := TRUE;
  451.       END
  452.    ELSE IF ( Ch = NAK ) THEN
  453.       Use_Crc := FALSE
  454.    ELSE IF ( Ch = ORD( 'C' ) ) THEN
  455.       Use_Crc := TRUE;
  456.                                    (* Indicate OK reception             *)
  457.    IF ( NOT Stop_Send ) THEN
  458.       BEGIN
  459.  
  460.          GoToXY( 26 , 51 );
  461.          WRITE('Received ');
  462.          ClrEol;
  463.                                    (* Set header character              *)
  464.  
  465.          IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN
  466.             Header_Ch := CHR( STX )
  467.          ELSE
  468.             Header_Ch := CHR( SOH );
  469.  
  470.          New_Header_Ch := Header_Ch;
  471.  
  472.                                    (* If Telink or Ymodem, send the   *)
  473.                                    (* special initial sector, already *)
  474.                                    (* prepared in Send_Modem7_File or *)
  475.                                    (* Send_Ymodem_File                *)
  476.  
  477.          IF Transfer_Protocol = Ymodem_Batch THEN
  478.             Send_Ymodem_Header
  479.          ELSE IF Transfer_Protocol = Telink THEN
  480.             Send_Telink_Header;
  481.  
  482.       END;
  483.                                    (* Begin loop over blocks in file    *)
  484.    REPEAT
  485.                                    (* See if Alt-S hit, ending transfer *)
  486.       Check_Keyboard;
  487.  
  488.       Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
  489.  
  490.       IF ( NOT Stop_Send ) THEN
  491.          BEGIN (* Send the next sector *)
  492.  
  493.                                    (* Set block header character        *)
  494.  
  495.             Header_Ch := New_Header_Ch;
  496.  
  497.                                    (* Read Sector_size chars from file  *)
  498.                                    (* to be sent.                       *)
  499.             NRead := Sector_Size;
  500.  
  501.             I := Read_File_Handle( XFile_Handle, Sector_Data, NRead );
  502.  
  503.                                    (* Check for error *)
  504.  
  505.             IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN
  506.                BEGIN
  507.                   Display_Send_Error('Cannot read data from file', TRUE);
  508.                   Stop_Send := TRUE;
  509.                END
  510.                                    (* If no chars. read, then EOF      *)
  511.  
  512.             ELSE IF NRead <= 0 THEN
  513.                EOF_Xfile := TRUE
  514.             ELSE
  515.                BEGIN   (* NOT Eof *)
  516.  
  517.                                    (* Compute Checksum or Crc           *)
  518.                   IF Use_Crc THEN
  519.                      BEGIN (* Use CRC *)
  520.  
  521.                         Sector_Data[ Sector_Size1 ] := 0;
  522.                         Sector_Data[ Sector_Size2 ] := 0;
  523.  
  524.                         Crc := 0;
  525.  
  526.                         FOR I := 1 TO Sector_Size2 DO
  527.                            Crc := Update_Crc( Crc , Sector_Data[I] );
  528.  
  529.                         Sector_Data[ Sector_Size1 ] := HI( Crc );
  530.                         Sector_Data[ Sector_Size2 ] := LO( Crc );
  531.  
  532.                      END   (* Use CRC *)
  533.                   ELSE
  534.                      BEGIN (* Use Checksum *)
  535.  
  536.                         Checksum := 0;
  537.  
  538.                         FOR I := 1 TO Sector_Size DO
  539.                            Checksum := ( Checksum + Sector_Data[ I ] ) MOD 256;
  540.  
  541.                         Sector_Data[ Sector_Size1 ] := Checksum;
  542.  
  543.                      END   (* Use Checksum *);
  544.  
  545.                                    (* Increment sector number           *)
  546.  
  547.                   Sector_Number := Sector_Number + 1;
  548.                   Sector_Count  := Sector_Count  + 1;
  549.  
  550.                                    (* Send the block *)
  551.                   Send_Xmodem_Block;
  552.  
  553.                                    (* Update transmit time and counts *)
  554.                                    (* of good/bad sectors; also shift *)
  555.                                    (* to 128 byte sectors in Ymodem   *)
  556.                                    (* if ratio of bad/good > 1/6.     *)
  557.  
  558.                   IF Ch = ACK THEN
  559.                      BEGIN
  560.                         Time_To_Send := Time_To_Send - Time_Per_Blk;
  561.                         IF Time_To_Send < 0.0 THEN Time_To_Send := 0.0;
  562.                         Good_Sectors := Good_Sectors + 1;
  563.                      END
  564.                  ELSE
  565.                     BEGIN
  566.                        Bad_Sectors := Bad_Sectors + 1;
  567.                        IF ( Bad_Threshhold * Bad_Sectors > Good_Sectors ) THEN
  568.                           BEGIN
  569.  
  570.                              New_Header_Ch := CHR( SOH );
  571.  
  572.                              Sector_Size := 128;
  573.  
  574.                              Sector_Size1 := Sector_Size + 1;
  575.                              Sector_Size2 := Sector_Size + 2;
  576.  
  577.                              IF Use_Crc THEN
  578.                                 Sector_Length := Sector_Size2
  579.                              ELSE
  580.                                 Sector_Length := Sector_Size1;
  581.  
  582.                           END;
  583.                     END;
  584.  
  585.                END (* Not EOF *)
  586.  
  587.          END (* Send Next Sector *);
  588.  
  589.    UNTIL ( EOF_Xfile ) OR ( Tries = Max_Tries ) OR ( Ch = CAN ) OR
  590.          ( Stop_Send );
  591.                                    (* Send CANs to host to cancel *)
  592.                                    (* transfer                    *)
  593.    IF Stop_Send THEN
  594.       IF Async_Carrier_Detect THEN
  595.          Cancel_Transfer;
  596.  
  597.    IF Tries >= Max_Tries THEN   (* We failed to send a sector correctly *)
  598.       Display_Send_Error('No ACK ever received.' , FALSE)
  599.    ELSE IF ( Ch = CAN ) THEN   (* Receiver cancelled transmission *)
  600.       Display_Send_Error('Receiver cancelled transmission.',FALSE)
  601.    ELSE IF Alt_S_Found  THEN (* User cancelled transmission *)
  602.       Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE)
  603.    ELSE IF ( NOT Stop_Send ) THEN  (* We sent everything, try sending EOT *)
  604.       BEGIN
  605.  
  606.          GoToXY( 26 , 8 );
  607.          WRITE('Waiting for ACK of EOT');
  608.          ClrEol;
  609.  
  610.          Tries := 0;
  611.  
  612.          REPEAT
  613.  
  614.             Async_Send( CHR( EOT ) );
  615.  
  616.             Tries := Tries + 1;
  617.  
  618.             Xmodem_Wait_For_Ch( Ch );
  619.  
  620.             IF Ch = CAN THEN
  621.                Xmodem_Wait_For_Ch( Ch );
  622.  
  623.             Update_Xmodem_Send_Display;
  624.  
  625.          UNTIL ( Ch    = ACK       ) OR
  626.                ( Tries = Max_Tries ) OR
  627.                ( Ch    = CAN       ) OR
  628.                Stop_Send;
  629.  
  630.          IF Tries = Max_Tries THEN
  631.             Display_Send_Error('No ACK on EOT (end of transmission)', FALSE)
  632.          ELSE IF ( Ch = CAN ) THEN
  633.             Display_Send_Error('Receiver cancelled transmission.' , FALSE)
  634.          ELSE IF ( Alt_S_Found OR Stop_Send ) THEN
  635.             Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE)
  636.          ELSE
  637.             BEGIN
  638.  
  639.                GoToXY( 26 , 8 );
  640.                WRITE('EOT acknowledged, transfer complete.');
  641.                ClrEol;
  642.  
  643.                End_Time       := TimeOfDay;
  644.                R_Sector_Size  := Sector_Size;
  645.  
  646.                IF End_Time > Start_Time THEN
  647.                   BEGIN
  648.                      Effective_Rate := ( Blocks_To_Send * R_Sector_Size ) /
  649.                                        ( End_Time - Start_Time );
  650.                      DELAY( One_Second_Delay );
  651.                      GoToXY( 26 , 8 );
  652.                      WRITE('Transfer rate was ',Effective_Rate:6:1,' CPS');
  653.                      ClrEol;
  654.                   END;
  655.  
  656.                Writelne( ' Sent file ' + FileName, FALSE );
  657.  
  658.             END;
  659.  
  660.       END;
  661.  
  662.    IF Stop_Send THEN
  663.       IF Async_Carrier_Drop THEN
  664.          Display_Send_Error('Carrier dropped.' , FALSE );
  665.  
  666.                                       (* Close transferred file           *)
  667.  
  668.    I := Close_File_Handle( XFile_Handle );
  669.    I := Int24Result;
  670.  
  671.    DELAY( Two_Second_Delay );
  672.                                    (* Remove XMODEM window             *)
  673.    Restore_Screen( Saved_Screen );
  674.  
  675.    Reset_Global_Colors;
  676.  
  677. END   (* Send_Xmodem_File *);
  678. ə