home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S4.ARC / SENDXMOD.MOD < prev    next >
Encoding:
Text File  |  1988-03-23  |  37.8 KB  |  1,042 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                Send_Xmodem_File --- Upload file using XMODEM         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Send_Xmodem_File( Use_CRC : BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Send_Xmodem_File                                     *)
  10. (*                                                                      *)
  11. (*     Purpose:    Uploads file to remote host using XMODEM protocol.   *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Send_Xmodem_File( Use_CRC );                                  *)
  16. (*                                                                      *)
  17. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  18. (*                       of XMODEM; FALSE to use Checksum version.      *)
  19. (*                                                                      *)
  20. (*     Remarks:                                                         *)
  21. (*                                                                      *)
  22. (*        The file's existence should have been already checked         *)
  23. (*        prior to calling this routine.                                *)
  24. (*                                                                      *)
  25. (*        The transmission parameters are automatically set to:         *)
  26. (*                                                                      *)
  27. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  28. (*                                                                      *)
  29. (*        and then they are automatically restored to the previous      *)
  30. (*        values when the transfer is complete.                         *)
  31. (*                                                                      *)
  32. (*     Calls:    PibTerm_KeyPressed                                             *)
  33. (*               Async_Send                                             *)
  34. (*               Async_Receive                                          *)
  35. (*               Compute_Crc                                            *)
  36. (*               Draw_Menu_Frame                                        *)
  37. (*               Save_Screen                                            *)
  38. (*               Restore_Screen                                         *)
  39. (*               Async_Open                                             *)
  40. (*                                                                      *)
  41. (*----------------------------------------------------------------------*)
  42.  
  43.                                    (* If this threshhold value x number *)
  44.                                    (* of bad blocks > number of good    *)
  45.                                    (* blocks, reduce block size to 128  *)
  46. CONST
  47.    Bad_Threshhold  = 6;
  48.    SOH_Tries       = 5;
  49.    NAK_Ch          = ^U;
  50.    WXmodem_Window  = 4;
  51.    SeaLink_Window  = 6;
  52.  
  53. VAR
  54.    I               : INTEGER       (* Loop index                        *);
  55.    L               : INTEGER       (* General length                    *);
  56.    Tries           : INTEGER       (* # of tries sending current sector *);
  57.    Checksum        : INTEGER       (* Sector checksum                   *);
  58.    Crc             : INTEGER       (* Cyclic redundancy check           *);
  59.    Ch              : INTEGER       (* Character received from COM port  *);
  60.    Kbd_Ch          : CHAR          (* Absorbs keyboard characters       *);
  61.    Send_Errors     : INTEGER       (* Counts transfer errors            *);
  62.    Sector_Count    : INTEGER       (* Sector count -- no wrap at 255    *);
  63.    Transfer_Time   : INTEGER       (* Transfer time in seconds          *);
  64.    Effective_Rate  : REAL          (* Effective baud rate of transfer   *);
  65.    NRead           : INTEGER       (* Records actually read from file   *);
  66.    EOF_XFile       : BOOLEAN       (* EOF encountered on file to send   *);
  67.    SCps            : STRING[20]    (* String form of CPS transfer rate  *);
  68.    Max_Tries       : INTEGER       (* Max. number of retries            *);
  69.    R_File_Size     : LONGINT       (* File size                         *);
  70.    Header_Ch       : CHAR          (* Block header character            *);
  71.    New_Header_Ch   : CHAR          (* Revised block header if downshift *);
  72.    Bad_Sectors     : INTEGER       (* Count of bad sectors              *);
  73.    Good_Sectors    : INTEGER       (* Count of good sectors             *);
  74.    ITime           : INTEGER       (* Counter for wait loops            *);
  75.    XFile_Size      : LONGINT       (* File size in characters           *);
  76.    Save_XonXoff    : BOOLEAN       (* Saves XON/XOFF status             *);
  77.    ACK_Window      : INTEGER       (* ACK window size for WXModem       *);
  78.    ACK_Sector      : INTEGER       (* Sector # ACK'd or NAK'd           *);
  79.    Max_ACK_Window  : INTEGER       (* Max # of sectors in window        *);
  80.    Max_Window_Size : INTEGER       (* Max window size                   *);
  81.    Max_Window_Size1: INTEGER       (* Max window size + 1               *);
  82.    Sending_Title   : AnyStr        (* Title for send                    *);
  83.    Err_Mess        : AnyStr        (* Error message text                *);
  84.  
  85. CONST
  86.    Ymodem_Family   : SET OF Transfer_Type =
  87.                      [ Xmodem_1K, Xmodem_1KG, Ymodem_Batch, Ymodem_G];
  88.  
  89. LABEL 1;
  90.  
  91. (*----------------------------------------------------------------------*)
  92. (*   Update_Xmodem_Send_Display --- Update display of Xmodem sending    *)
  93. (*----------------------------------------------------------------------*)
  94.  
  95. PROCEDURE Update_Xmodem_Send_Display;
  96.  
  97. BEGIN (* Update_Xmodem_Send_Display *)
  98.  
  99.    GoToXY( 26 , 4 );
  100.    WRITE( Sector_Count );
  101.    GoToXY( 35 , 4 );
  102.    WRITE( Sector_Count SHR 3, 'K' );
  103.    GoToXY( 26 , 5 );
  104.    WRITE( Send_Errors  );
  105.  
  106. END   (* Update_Xmodem_Send_Display *);
  107.  
  108. (*----------------------------------------------------------------------*)
  109. (*         Display_Send_Error --- Display XMODEM sending error          *)
  110. (*----------------------------------------------------------------------*)
  111.  
  112. PROCEDURE Display_Send_Error( Err_Text: AnyStr; Display_Block: BOOLEAN );
  113.  
  114. VAR
  115.    S: STRING[10];
  116.    I: INTEGER;
  117.  
  118. BEGIN (* Display_Send_Error *)
  119.  
  120.    IF ( NOT Display_Status ) THEN
  121.       Flip_Display_Status;
  122.  
  123.    Err_Mess := Err_Text;
  124.  
  125.    IF Display_Block THEN
  126.       BEGIN
  127.          I := MAX( Sector_Count - 1 , 0 );
  128.          STR( I , S );
  129.          Err_Mess := Err_Mess + ' at/before block ' + S;
  130.       END;
  131.  
  132.    GoToXY( 26 , 8 );
  133.    WRITE(Err_Mess);
  134.    ClrEol;
  135.  
  136.    Write_Log( Err_Mess, TRUE, FALSE );
  137.  
  138. END   (* Display_Send_Error *);
  139.  
  140. (*----------------------------------------------------------------------*)
  141. (*        Xmodem_Wait_For_Ch --- wait for character to appear           *)
  142. (*----------------------------------------------------------------------*)
  143.  
  144. PROCEDURE Xmodem_Wait_For_Ch(     Wait_Time: INTEGER;
  145.                               VAR Ch       : INTEGER );
  146.  
  147. VAR
  148.    ITime : INTEGER;
  149.  
  150. BEGIN (* Xmodem_Wait_For_Ch *)
  151.  
  152.    ITime := 0;
  153.  
  154.    REPEAT
  155.       INC( ITime );
  156.       Async_Receive_With_Timeout( One_Second , Ch );
  157.       Check_KeyBoard;
  158.    UNTIL ( Ch <> TimeOut ) OR ( ITime >= Wait_Time ) OR Stop_Send;
  159.  
  160. END   (* Xmodem_Wait_For_Ch *);
  161.  
  162. (*----------------------------------------------------------------------*)
  163. (*           Do_Initial_Handshake --- Do initial C/G/NAK handshaking    *)
  164. (*----------------------------------------------------------------------*)
  165.  
  166. PROCEDURE Do_Initial_Handshake;
  167.  
  168. BEGIN (* Do_Initial_Handshake *)
  169.                                    (* Get initial character             *)
  170.    GoToXY( 26 , 8 );
  171.    WRITE('Wait for NAK/C/G/W --- ');
  172.    ClrEol;
  173.                                    (* Set window size *)
  174.    Max_Window_Size  := 0;
  175.    Max_Window_Size1 := 1;
  176.                                    (* Look for NAK/C/G/W *)
  177.    REPEAT
  178.  
  179.       Xmodem_Wait_For_Ch( Xmodem_Block_Wait , Ch );
  180.  
  181.                                    (* If CAN, insist on another *)
  182.       IF Ch = CAN THEN
  183.          Xmodem_Wait_For_Ch( Xmodem_ACK_Wait , Ch );
  184.  
  185.       INC( Tries );
  186.  
  187.       Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
  188.  
  189.    UNTIL ( Tries > SOH_Tries  ) OR
  190.          ( Ch    = NAK        ) OR
  191.          ( Ch    = ORD( 'C' ) ) OR
  192.          ( Ch    = ORD( 'G' ) ) OR
  193.          ( Ch    = ORD( 'W' ) ) OR
  194.          ( Ch    = CAN        ) OR
  195.          Stop_Send;
  196.  
  197.    IF ( Ch    = TimeOut   ) OR
  198.       ( Tries > SOH_Tries ) OR
  199.       ( Ch    = CAN       ) THEN
  200.       BEGIN
  201.          IF ( NOT Display_Status ) THEN
  202.             Flip_Display_Status;
  203.          GoToXY( 26 , 51 );
  204.          WRITE('Not Received ');
  205.          ClrEol;
  206.          Stop_Send := TRUE;
  207.       END
  208.    ELSE IF ( Ch = NAK ) THEN
  209.       Use_Crc := FALSE
  210.    ELSE IF ( Ch = ORD( 'C' ) ) THEN
  211.       Use_Crc := TRUE
  212.    ELSE IF ( Ch = ORD( 'G' ) ) THEN
  213.       BEGIN
  214.          Use_Crc          := TRUE;
  215.          Do_ACKs          := FALSE;
  216.          Async_Do_XonXoff := TRUE;
  217.       END
  218.    ELSE IF ( Ch = ORD( 'W' ) ) THEN
  219.       BEGIN
  220.          Use_Crc          := TRUE;
  221.          Do_WXModem       := TRUE;
  222.          Async_Do_XonXoff := TRUE;
  223.          Max_ACK_Window   := WXmodem_Window;
  224.          Max_Window_Size  := WXmodem_Window;
  225.          Max_Window_Size1 := SUCC( Max_Window_Size );
  226.       END;
  227.                                    (* Indicate OK reception             *)
  228.    IF ( NOT Stop_Send ) THEN
  229.       BEGIN
  230.  
  231.          IF ( NOT Display_Status ) THEN
  232.             Flip_Display_Status;
  233.  
  234.          GoToXY( 26 , 51 );
  235.  
  236.          WRITE('Received ');
  237.  
  238.          CASE CHR( Ch ) OF
  239.             'C','G','W' : WRITE( CHR( Ch ) );
  240.             NAK_Ch      : WRITE('NAK');
  241.             ELSE;
  242.          END (* CASE *);
  243.  
  244.          ClrEol;
  245.  
  246.       END;
  247.                                    (* Reset status line *)
  248.    IF Do_Status_Line THEN
  249.       BEGIN
  250.          Set_Status_Line_Name( Short_Terminal_Name );
  251.          Write_To_Status_Line( Status_Line_Name, 1 );
  252.       END;
  253.  
  254. END   (* Do_Initial_Handshake *);
  255.  
  256. (*----------------------------------------------------------------------*)
  257. (*      Async_Send_DLE_Char --- Send possibly DLE-quoted character      *)
  258. (*----------------------------------------------------------------------*)
  259.  
  260. PROCEDURE Async_Send_DLE_Char( C: CHAR );
  261.  
  262. (* STRUCTURED *) CONST
  263.    DLE_Chars : SET OF CHAR = [ ^P, ^Q, ^S, ^V ];
  264.  
  265. BEGIN (* Async_Send_DLE_Char *)
  266.  
  267.    IF ( NOT Do_WXModem ) THEN
  268.       Async_Send( C )
  269.    ELSE
  270.       BEGIN
  271.          IF ( C IN DLE_Chars ) THEN
  272.             BEGIN
  273.                Async_Send( CHR( DLE ) );
  274.                C := CHR( ORD( C ) XOR 64 );
  275.             END;
  276.          Async_Send( C );
  277.       END;
  278.  
  279. END   (* Async_Send_DLE_Char *);
  280.  
  281. (*----------------------------------------------------------------------*)
  282. (*               Handle_Sector_ACK --- Handle ACK/NAK for sectors       *)
  283. (*----------------------------------------------------------------------*)
  284.  
  285. PROCEDURE Handle_Sector_ACKNAK( VAR Ch: INTEGER );
  286.  
  287. VAR
  288.    ACK_Ch     : INTEGER;
  289.    Comp_Ch    : CHAR;
  290.  
  291. BEGIN (* Handle_Sector_ACKNAK *)
  292.  
  293.                                    (* Assume an ACK by default.            *)
  294.    Ch := ACK;
  295.                                    (* If sliding windows, we don't need to *)
  296.                                    (* wait here until send window is full. *)
  297.  
  298.    IF ( Do_WXModem OR Do_SeaLink ) THEN
  299.       IF ( ACK_Window < Max_ACK_Window ) THEN
  300.          IF ( Async_Buffer_Head = Async_Buffer_Tail ) THEN
  301.             EXIT;
  302.                                    (* Pick up a character -- should be ACK *)
  303.  
  304.    Xmodem_Wait_For_Ch( Xmodem_Ack_Wait , Ch );
  305.  
  306.                                    (* If CAN, insist on another *)
  307.    IF ( Ch = CAN ) THEN
  308.       BEGIN
  309.          Xmodem_Wait_For_Ch( Xmodem_Ack_Wait , Ch );
  310.          IF ( Ch = CAN ) THEN EXIT;
  311.       END;
  312.                                    (* If sliding windows, pick up sector   *)
  313.                                    (* for which ACK/NAK applies.  Adjust   *)
  314.                                    (* ACK_Window to reflect sectors not    *)
  315.                                    (* ACK'd yet.                           *)
  316.  
  317.    ACK_Sector := Sector_Number;
  318.  
  319.    IF ( Do_WXModem OR Do_SeaLink ) THEN
  320.       BEGIN
  321.          IF ( ( Ch = ACK ) OR ( Ch = NAK ) ) THEN
  322.             BEGIN
  323.  
  324.                XModem_Wait_For_Ch( XModem_Ack_Wait , ACK_Ch );
  325.  
  326.                IF Do_WXModem THEN
  327.                   IF ( ACK_Ch > PRED( Max_Window_Size ) ) THEN
  328.                      Ch := ACK
  329.                   ELSE
  330.                      BEGIN
  331.                         ACK_Sector := ( ACK_Ch AND 3 );
  332.                         ACK_Window := ( Sector_Number AND 3 ) - ACK_Sector;
  333.                         IF ( ACK_Window < 0 ) THEN
  334.                            ACK_Window := ACK_Window + Max_Window_Size;
  335.                      END
  336.  
  337.                ELSE IF Do_SeaLink THEN
  338.                   BEGIN
  339.                      IF Async_Receive( Comp_Ch ) THEN
  340.                         IF ( ( ORD( Comp_Ch ) + ACK_Ch ) = 255 ) THEN
  341.                            BEGIN
  342.                               ACK_Sector := ( ACK_Ch MOD Max_Window_Size1 );
  343.                               ACK_Window := ( Sector_Number MOD Max_Window_Size1 ) - ACK_Sector;
  344.                               IF ( ACK_Window < 0 ) THEN
  345.                                  ACK_Window := ACK_Window + Max_Window_Size;
  346.                            END
  347.                         ELSE
  348.                            Max_ACK_Window := 0
  349.                      ELSE
  350.                         Max_ACK_Window := 0;
  351.                   END  (* IF SeaLink *);
  352.  
  353.             END (* IF Ach = ACK or BAK *);
  354.  
  355.       END (* IF sliding windows *);
  356.  
  357.                                    (* Display message about NAK *)
  358.    IF ( Ch <> ACK ) THEN
  359.       BEGIN
  360.          Display_Send_Error('No ACK', TRUE);
  361.          INC( Send_Errors );
  362.       END;
  363.  
  364. END   (* Handle_Sector_ACKNAK *);
  365.  
  366. (*----------------------------------------------------------------------*)
  367. (*               Send_Xmodem_Block --- send out Xmodem block            *)
  368. (*----------------------------------------------------------------------*)
  369.  
  370. PROCEDURE Send_Xmodem_Block;
  371.  
  372. VAR
  373.    I          : INTEGER;
  374.    Send_State : INTEGER;
  375.  
  376. BEGIN (* Send_Xmodem_Block *)
  377.                                    (* Reset error count to zero *)
  378.    Tries := 0;
  379.                                    (* Set sending state.  States depend on: *)
  380.                                    (*                                       *)
  381.                                    (*    CRC vs CheckSum                    *)
  382.                                    (*    If Spooling on/off                 *)
  383.                                    (*    If resending or not                *)
  384.    IF CRC_Used THEN
  385.       Send_State := 1
  386.    ELSE
  387.       Send_State := 0;
  388.  
  389.    IF Print_Spooling THEN
  390.       Send_State := Send_State + 2;
  391.  
  392.    REPEAT
  393.                                    (* Send SYN if doing WXModem *)
  394.       IF Do_WXModem THEN
  395.          Async_Send( CHR( SYN ) );
  396.  
  397.                                    (* Send 1st char of block *)
  398.  
  399.       Async_Send_DLE_Char( Header_Ch );
  400.  
  401.                                    (* Send block number and complement *)
  402.  
  403.       Async_Send_DLE_Char( CHR(       Sector_Number ) );
  404.       Async_Send_DLE_Char( CHR( 255 - Sector_Number ) );
  405.  
  406.                                    (* Transmit Sector Data *)
  407.       CASE Send_State OF
  408.  
  409.          0:  BEGIN
  410.                 CheckSum := 0;
  411.                 FOR I := 1 TO Sector_Size DO
  412.                    BEGIN
  413.                       Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  414.                       CheckSum := ( CheckSum + Sector_Data[ I ] ) AND $FF;
  415.                    END;
  416.                 Async_Send_DLE_Char( CHR( CheckSum ) );
  417.              END;
  418.  
  419.          1:  BEGIN
  420.                 Crc := 0;
  421.                 FOR I := 1 TO Sector_Size DO
  422.                    BEGIN
  423.                       Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  424.                       Crc := SWAP( Crc ) XOR Sector_Data[I];
  425.                       Crc := Crc XOR ( LO( Crc ) SHR 4 );
  426.                       Crc := Crc XOR ( SWAP( LO( Crc ) ) SHL 4 ) XOR
  427.                               ( LO( Crc ) SHL 5 );
  428.                    END;
  429.                 Async_Send_DLE_Char( CHR( HI( CRC ) ) );
  430.                 Async_Send_DLE_Char( CHR( LO( CRC ) ) );
  431.              END;
  432.  
  433.          2:  BEGIN
  434.                 CheckSum := 0;
  435.                 FOR I := 1 TO Sector_Size DO
  436.                    BEGIN
  437.                       Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  438.                       CheckSum := ( CheckSum + Sector_Data[ I ] ) AND $FF;
  439.                       IF Print_Spooling THEN
  440.                          Print_Spooled_File;
  441.                    END;
  442.                 Async_Send_DLE_Char( CHR( CheckSum ) );
  443.              END;
  444.  
  445.          3:  BEGIN
  446.                 Crc := 0;
  447.                 FOR I := 1 TO Sector_Size DO
  448.                    BEGIN
  449.                       Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  450.                       Crc := SWAP( Crc ) XOR Sector_Data[I];
  451.                       Crc := Crc XOR ( LO( Crc ) SHR 4 );
  452.                       Crc := Crc XOR ( SWAP( LO( Crc ) ) SHL 4 ) XOR
  453.                               ( LO( Crc ) SHL 5 );
  454.                       IF Print_Spooling THEN
  455.                          Print_Spooled_File;
  456.                    END;
  457.                 Async_Send_DLE_Char( CHR( HI( CRC ) ) );
  458.                 Async_Send_DLE_Char( CHR( LO( CRC ) ) );
  459.              END;
  460.  
  461.          4:  BEGIN
  462.                 FOR I := 1 TO Sector_Size DO
  463.                    Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  464.                 Async_Send_DLE_Char( CHR( CheckSum ) );
  465.              END;
  466.  
  467.          5:  BEGIN
  468.                 FOR I := 1 TO Sector_Size DO
  469.                    Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  470.                 Async_Send_DLE_Char( CHR( HI( CRC ) ) );
  471.                 Async_Send_DLE_Char( CHR( LO( CRC ) ) );
  472.              END;
  473.  
  474.          6:  BEGIN
  475.                 FOR I := 1 TO Sector_Size DO
  476.                    BEGIN
  477.                       Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  478.                       IF Print_Spooling THEN
  479.                          Print_Spooled_File;
  480.                    END;
  481.                 Async_Send_DLE_Char( CHR( CheckSum ) );
  482.              END;
  483.  
  484.          7:  BEGIN
  485.                 FOR I := 1 TO Sector_Size DO
  486.                    BEGIN
  487.                       Async_Send_DLE_Char( CHR( Sector_Data[ I ] ) );
  488.                       IF Print_Spooling THEN
  489.                          Print_Spooled_File;
  490.                    END;
  491.                 Async_Send_DLE_Char( CHR( HI( CRC ) ) );
  492.                 Async_Send_DLE_Char( CHR( LO( CRC ) ) );
  493.              END;
  494.  
  495.       END (* CASE *);
  496.                                    (* Purge receive buffer *)
  497.  
  498.       IF ( NOT ( Do_WXModem OR Do_SEALink OR ( NOT Do_Acks ) ) ) THEN
  499.          Async_Purge_Buffer;
  500.                                    (* Not first time through anymore *)
  501.  
  502.       Send_State := Send_State OR 4;
  503.  
  504.                                    (* Increment count of tries to send  *)
  505.                                    (* for this sector.                  *)
  506.       INC( Tries );
  507.                                    (* Handle sector ACK/NAK             *)
  508.       IF Do_Acks THEN
  509.          Handle_Sector_ACKNAK( Ch )
  510.       ELSE
  511.          Ch := ACK;
  512.                                    (* Update display *)
  513.       IF Display_Status THEN
  514.          Update_Xmodem_Send_Display;
  515.  
  516.    UNTIL ( Ch = ACK           ) OR
  517.          ( Ch = CAN           ) OR
  518.          ( Tries > Max_Tries  ) OR
  519.          ( Stop_Send          ) OR
  520.          ( Async_Carrier_Drop ) OR
  521.          ( Do_WXModem         ) OR
  522.          ( Do_SEALink         );
  523.                                    (* Inc WXModem un-ACKd sector count *)
  524.  
  525.    INC( ACK_Window );
  526.  
  527.                                    (* Ensure Stop_Send TRUE if carrier *)
  528.                                    (* dropped.                         *)
  529.  
  530.    Stop_Send := Stop_Send OR Async_Carrier_Drop;
  531.  
  532. END   (* Send_Xmodem_Block *);
  533.  
  534. (*----------------------------------------------------------------------*)
  535. (*      Send_Telink_Header --- send out special block 0 for Telink      *)
  536. (*----------------------------------------------------------------------*)
  537.  
  538. PROCEDURE Send_Telink_Header;
  539.  
  540. VAR
  541.    Save_Size: INTEGER;
  542.    Save_CRC : BOOLEAN;
  543.  
  544. BEGIN (* Send_Telink_Header *)
  545.                                    (* Always send TELINK in Checksum mode *)
  546.    Max_Tries     := 3;
  547.    Save_Size     := Sector_Size;
  548.    Save_CRC      := CRC_Used;
  549.    Sector_Size   := 128;
  550.    CRC_Used       := FALSE;
  551.    Header_Ch     := CHR( SYN );
  552.  
  553.    Send_Xmodem_Block;
  554.  
  555.    Sector_Size   := Save_Size;
  556.    CRC_Used       := Save_CRC;
  557.    Max_Tries     := Xmodem_Max_Errors;
  558.  
  559.    IF Display_Status THEN
  560.       IF ( Ch = ACK ) THEN
  561.          Display_Send_Error( 'Telink header accepted.' , FALSE )
  562.       ELSE
  563.          Display_Send_Error( 'Telink header not accepted.' , FALSE );
  564.  
  565. END   (* Send_Telink_Header *);
  566.  
  567. {
  568. (*----------------------------------------------------------------------*)
  569. (*      Send_SEAlink_Header --- send out special block 0 for SEAlink    *)
  570. (*----------------------------------------------------------------------*)
  571.  
  572. PROCEDURE Send_SEAlink_Header;
  573.  
  574. VAR
  575.    Save_Size: INTEGER;
  576.  
  577. BEGIN (* Send_SEAlink_Header *)
  578.  
  579.    Max_Tries     := 3;
  580.    Save_Size     := Sector_Size;
  581.    Sector_Size   := 128;
  582.    Header_Ch     := CHR( SOH );
  583.    CRC_Used      := TRUE;
  584.    Do_SEALink    := FALSE;
  585.  
  586.    Send_Xmodem_Block;
  587.  
  588.    Sector_Size   := Save_Size;
  589.    Max_Tries     := Xmodem_Max_Errors;
  590.    Do_SEALink    := TRUE;
  591.  
  592.    IF Display_Status THEN
  593.       IF ( Ch = ACK ) THEN
  594.          Display_Send_Error( 'SEAlink header accepted.' , FALSE )
  595.       ELSE
  596.          Display_Send_Error( 'SEAlink header not accepted.' , FALSE );
  597.  
  598. END   (* Send_SEAlink_Header *);
  599. }
  600.  
  601. (*----------------------------------------------------------------------*)
  602. (*      Send_Ymodem_Header --- send out special block 0 for Ymodem      *)
  603. (*----------------------------------------------------------------------*)
  604.  
  605. PROCEDURE Send_Ymodem_Header;
  606.  
  607. VAR
  608.    Save_Size: INTEGER;
  609.    Save_ACK : BOOLEAN;
  610.  
  611. BEGIN (* Send_Ymodem_Header *)
  612.                                    (* Always send short block 0 *)
  613.    Max_Tries     := 3;
  614.    Save_Size     := Sector_Size;
  615.    Sector_Size   := 128;
  616.    Header_Ch     := CHR( SOH );
  617.    Save_ACK      := Do_ACKs;
  618.    Do_ACKs       := TRUE;
  619.  
  620.    Send_Xmodem_Block;
  621.  
  622.    Sector_Size := Save_Size;
  623.    Do_ACKs     := Save_ACK;
  624.    Max_Tries   := Xmodem_Max_Errors;
  625.  
  626.    IF Display_Status THEN
  627.       IF ( Ch = ACK ) THEN
  628.          Display_Send_Error( 'Ymodem header accepted.' , FALSE )
  629.       ELSE
  630.          Display_Send_Error( 'Ymodem header not accepted.' , FALSE );
  631.  
  632. END   (* Send_Ymodem_Header *);
  633.  
  634. (*----------------------------------------------------------------------*)
  635.  
  636. BEGIN (* Send_Xmodem_File *)
  637.                                    (* Remember CRC checking *)
  638.    CRC_Used := Use_CRC;
  639.                                    (* Get file name for transfer *)
  640.  
  641.    Add_Path( FileName, Upload_Dir_Path, XFile_Name );
  642.  
  643.                                    (* Get Xmodem transfer display *)
  644.    Get_Xmodem_Titles;
  645.  
  646.    FileMode := 0;
  647.  
  648.    ASSIGN( XFile , XFile_Name );
  649.       (*!I-*)
  650.    RESET ( XFile , 1 );
  651.       (*!I+*)
  652.  
  653.    FileMode := 2;
  654.  
  655.    IF ( Int24Result <> 0 ) THEN
  656.       BEGIN
  657.          WRITE('Cannot open file to send, transfer cancelled.');
  658.          Cancel_Transfer;
  659.          Window_Delay;
  660.          Restore_Screen_And_Colors( Saved_Screen );
  661.          EXIT;
  662.       END;
  663.                                    (* Get file size in characters.      *)
  664.  
  665.    XFile_Size  := FileSize( XFile );
  666.    R_File_Size := XFile_Size;
  667.                                    (* Number of retries of bad block *)
  668.  
  669.    Max_Tries   := Xmodem_Max_Errors;
  670.  
  671.                                    (* Figure approx. time for upload *)
  672.  
  673.    Blocks_To_Send     := ROUND( ( XFile_Size / 128 ) + 0.49 );
  674.    Saved_Time_To_Send := ROUND( Blocks_To_Send * ( Trans_Time_Val / Baud_Rate ) );
  675.    Time_To_Send       := Saved_Time_To_Send;
  676.  
  677.                                    (* Hide cursor *)
  678.    CursorOff;
  679.                                    (* Headings for status information *)
  680.    Initialize_Send_Display;
  681.  
  682.    STR( R_File_Size , SCps );
  683.    Write_Log('Size of file to send is ' + SCps + ' bytes', TRUE, FALSE );
  684.  
  685.                                    (* Determine sector size             *)
  686.                                    (* Note:  If Ymodem and downsizing   *)
  687.                                    (*        allowed, and file is < 1K, *)
  688.                                    (*        use short sectors.         *)
  689.                                    (* Also set header character.        *)
  690.    Header_Ch := CHR( SOH );
  691.  
  692.    IF ( Transfer_Protocol IN [Xmodem_1K, Xmodem_1KG, Ymodem_Batch, Ymodem_G] ) THEN
  693.       BEGIN
  694.          IF ( DownSize_Ymodem AND ( XFile_Size < 1024 ) ) THEN
  695.             BEGIN
  696.                Sector_Size := 128;
  697.                Display_Send_Error('Switching to 128 byte blocks', FALSE);
  698.             END
  699.          ELSE
  700.             BEGIN
  701.                Sector_Size := 1024;
  702.                Header_Ch := CHR( STX );
  703.             END
  704.       END
  705.    ELSE
  706.       Sector_Size := 128;
  707.  
  708.    New_Header_Ch := Header_Ch;
  709.  
  710.                                    (* Sector #s start at 1, wrap at 255 *)
  711.    Sector_Number := 0;
  712.    Sector_Count  := 0;
  713.                                    (* No errors yet                     *)
  714.    Send_Errors   := 0;
  715.                                    (* Set TRUE if errors halt transfer  *)
  716.    Stop_Send     := FALSE;
  717.                                    (* Starting time for transfer        *)
  718.    Start_Time    := TimeOfDay;
  719.                                    (* Set EOF on XFile to FALSE         *)
  720.    EOF_XFile     := FALSE;
  721.                                    (* Set Alt_S encountered off         *)
  722.    Alt_S_Pressed   := FALSE;
  723.                                    (* No retries yet                    *)
  724.    Tries         := 0;
  725.                                    (* Assume ACKs                       *)
  726.    Do_ACKs       := TRUE;
  727.                                    (* Assume no windowing to be done    *)
  728.    Do_WXModem    := FALSE;
  729.    Do_SeaLink    := FALSE;
  730.    ACK_Window    := 0;
  731.    Max_ACK_Window:= 0;
  732.                                    (* Set up for SeaLink                *)
  733. {
  734.    IF ( Transfer_Protocol = SeaLink ) THEN
  735.       BEGIN
  736.          Do_SeaLink       := TRUE;
  737.          Max_Window_Size  := 6;
  738.          Max_Window_Size1 := 7;
  739.          Max_ACK_Window   := Max_Window_Size;
  740.       END;
  741. }
  742.                                    (* Purge receive buffer              *)
  743.    Async_Purge_Buffer;
  744.                                    (* Save Xon/Xoff status              *)
  745.  
  746.    Save_XonXoff     := Async_Do_XonXoff;
  747.    Async_Do_XonXoff := Honor_Xoff_Ymodem AND
  748.                        ( Transfer_Protocol IN Ymodem_Family );
  749.  
  750.                                    (* Do initial handshaking          *)
  751.    Do_Initial_Handshake;
  752.                                    (* If Telink or Ymodem, send the   *)
  753.                                    (* special initial sector, already *)
  754.                                    (* prepared in Send_Modem7_File or *)
  755.                                    (* Send_Ymodem_File                *)
  756.    IF ( NOT Stop_Send ) THEN
  757.       IF ( Transfer_Protocol IN [Ymodem_Batch, Ymodem_G] ) OR
  758.          ( ( Transfer_Protocol IN [Xmodem_1K, Xmodem_1KG] ) AND Use_Ymodem_Header ) THEN
  759.          BEGIN
  760.             Send_Ymodem_Header;
  761.             CRC_Used := TRUE;
  762.             Do_Initial_Handshake;
  763.          END
  764.       ELSE IF ( Transfer_Protocol = Telink ) THEN
  765.          BEGIN
  766.             Send_Telink_Header;
  767.             CRC_Used := TRUE;
  768.          END
  769. {
  770.       ELSE IF ( Transfer_Protocol = SEALink ) THEN
  771.          Send_SEALink_Header };
  772.  
  773.                                    (* Begin loop over blocks in file    *)
  774.    REPEAT
  775.                                    (* See if Alt-S hit, ending transfer *)
  776.       Check_Keyboard;
  777.  
  778.       Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
  779.  
  780.       IF ( NOT Stop_Send ) THEN
  781.          BEGIN (* Send the next sector *)
  782.  
  783.                                    (* Set block header character        *)
  784.  
  785.             Header_Ch := New_Header_Ch;
  786.  
  787.                                    (* Read Sector_size chars from file  *)
  788.                                    (* to be sent.                       *)
  789.  
  790.             BlockRead( XFile, Sector_Data, Sector_Size, NRead );
  791.  
  792.                                    (* Check for error *)
  793.  
  794.             IF ( Int24Result <> 0 ) THEN
  795.                BEGIN
  796.                   Display_Send_Error('Cannot read data from file', TRUE);
  797.                   Stop_Send := TRUE;
  798.                END
  799.                                    (* If no chars. read, then EOF      *)
  800.  
  801.             ELSE IF ( NRead <= 0 ) THEN
  802.                EOF_XFile := TRUE
  803.             ELSE
  804.                BEGIN   (* NOT Eof *)
  805.  
  806.                                    (* Fill out short sector with 0s     *)
  807.  
  808.                   IF ( NRead < Sector_Size ) THEN
  809.                      FILLCHAR( Sector_Data[NRead+1], Sector_Size - NRead + 1,
  810.                                0 );
  811.  
  812.                                    (* Increment sector number           *)
  813.  
  814.                   INC( Sector_Number );
  815.                   Sector_Count := Sector_Count + ( Sector_Size SHR 7 );
  816.  
  817.                                    (* Send the block *)
  818.  
  819.                   Send_Xmodem_Block;
  820.  
  821.                                    (* If Windowing, check if ACK.  If *)
  822.                                    (* not, backup to offending sector *)
  823.                                    (* and try again.                  *)
  824.  
  825.                   IF ( Do_WXModem OR Do_SeaLink ) THEN
  826.                      IF ( Ch = NAK ) THEN
  827.                         BEGIN
  828.                            Sector_Number := Sector_Number - ACK_Window;
  829.                            L             := ( ACK_Window + 1 ) * Sector_Size;
  830. {
  831.                            I := Relative_Position_File_Handle( XFile_Handle, -L );
  832. }
  833.                            SEEK( XFile , FilePos( XFile ) - L );
  834.                            EOF_XFile  := FALSE;
  835.                            XFile_Size := XFile_Size + L;
  836.                            GOTO 1;
  837.                         END;
  838.                                    (* Update transmit time and counts *)
  839.                                    (* of good/bad sectors; also shift *)
  840.                                    (* to 128 byte sectors in Ymodem   *)
  841.                                    (* if ratio of bad/good > 1/6 or   *)
  842.                                    (* less than 1024 bytes left.      *)
  843.  
  844.                   IF Ch = ACK THEN
  845.                      BEGIN
  846.                         Time_To_Send := ROUND( Saved_Time_To_Send *
  847.                                          ( 1.0 -
  848.                                            Sector_Count / Blocks_To_Send ) );
  849.                         IF Time_To_Send < 0 THEN Time_To_Send := 0;
  850.                         INC( Good_Sectors );
  851.                      END
  852.                   ELSE
  853.                      BEGIN
  854.                         INC( Bad_Sectors );
  855.                         IF ( Bad_Threshhold * Bad_Sectors > Good_Sectors ) AND
  856.                            ( Downsize_Ymodem ) AND ( Sector_Size = 1024 ) THEN
  857.                            BEGIN
  858.                               New_Header_Ch := CHR( SOH );
  859.                               Sector_Size   := 128;
  860.                               Display_Send_Error('Switching to 128 byte blocks',
  861.                                                  FALSE);
  862.                            END;
  863.                      END;
  864.                                    (* Alter sector size if Ymodem and *)
  865.                                    (* less than a Ymodem block left,  *)
  866.                                    (* and downsizing allowed.         *)
  867.  
  868.                   XFile_Size := XFile_Size - NRead;
  869.  
  870.                   IF ( ( XFile_Size < 1024 ) AND DownSize_Ymodem AND
  871.                        ( Sector_Size = 1024 ) ) THEN
  872.                      BEGIN
  873.                         New_Header_Ch := CHR( SOH );
  874.                         Sector_Size   := 128;
  875.                         Display_Send_Error('Switching to 128 byte blocks',
  876.                                            FALSE);
  877.                      END;
  878.  
  879.                END (* Not EOF *)
  880.  
  881.          END (* Send Next Sector *);
  882.  
  883.                                    (* Update display *)
  884. 1:       IF Display_Status THEN
  885.             BEGIN
  886.                GoToXY( 26 , 6 );
  887.                WRITE( TimeString( Time_To_Send , Military_Time ) );
  888.             END;
  889.  
  890.    UNTIL ( EOF_XFile ) OR ( Tries = Max_Tries ) OR ( Ch = CAN ) OR
  891.          ( Stop_Send );
  892.                                    (* If Windowing, wait for final  *)
  893.                                    (* ACKs to show up.              *)
  894.  
  895.    IF ( Do_WXModem OR Do_SeaLink ) THEN
  896.       BEGIN
  897.          Max_ACK_Window := 0;
  898.          WHILE( ( ACK_Window > 0 ) AND ( Ch <> CAN ) AND ( Ch <> TimeOut ) ) DO
  899.             Handle_Sector_ACKNAK( Ch );
  900.       END;
  901.  
  902.                                    (* Send CANs to host to cancel *)
  903.                                    (* transfer                    *)
  904.    IF Stop_Send THEN
  905.       IF Async_Carrier_Detect THEN
  906.          Cancel_Transfer;
  907.  
  908.    IF Tries >= Max_Tries THEN   (* We failed to send a sector correctly *)
  909.       Display_Send_Error('No ACK ever received.' , FALSE)
  910.    ELSE IF ( Ch = CAN ) THEN   (* Receiver cancelled transmission *)
  911.       Display_Send_Error('Receiver cancelled transmission.',FALSE)
  912.    ELSE IF Alt_S_Pressed  THEN (* User cancelled transmission *)
  913.       Display_Send_Error('Alt-S hit, send cancelled.',FALSE)
  914.    ELSE IF ( NOT Stop_Send ) THEN  (* We sent everything, try sending EOT *)
  915.       BEGIN
  916.  
  917.          IF ( NOT Display_Status ) THEN
  918.             Flip_Display_Status;
  919.                                    (* Wait for output buffer to drain *)
  920.                                    (* if not doing ACKs               *)
  921.          IF ( NOT Do_Acks ) THEN
  922.             BEGIN
  923.                GoToXY( 26 , 8 );
  924.                WRITE('Waiting for output buffer to drain');
  925.                ClrEol;
  926.                WHILE ( ( Async_OBuffer_Used > 128 ) AND ( NOT Stop_Send ) ) DO
  927.                   BEGIN
  928.                      Check_Keyboard;
  929.                      Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
  930.                      GiveAwayTime( 1 );
  931.                   END;
  932.             END;
  933.                                    (* Now indicate we're waiting for *)
  934.                                    (* ACK for EOT                    *)
  935.          GoToXY( 26 , 8 );
  936.          WRITE('Waiting for ACK of EOT');
  937.          ClrEol;
  938.  
  939.          Tries   := 0;
  940.          Do_ACKs := TRUE;
  941.  
  942.          REPEAT
  943.  
  944.             Async_Send( CHR( EOT ) );
  945.  
  946.             INC( Tries );
  947.  
  948.             Xmodem_Wait_For_Ch( Xmodem_Ack_Wait , Ch );
  949.  
  950.             IF Ch = CAN THEN
  951.                Xmodem_Wait_For_Ch( Xmodem_Ack_Wait , Ch );
  952.  
  953.             IF Display_Status THEN
  954.                BEGIN
  955.                   IF ( Tries > 1 ) THEN
  956.                      INC( Send_Errors );
  957.                   Update_Xmodem_Send_Display;
  958.                   GoToXY( 26 , 6 );
  959.                   WRITE( TimeString( Time_To_Send , Military_Time ) );
  960.                END;
  961.  
  962.             Check_Keyboard;
  963.  
  964.          UNTIL ( Ch    = ACK       ) OR
  965.                ( Tries = Max_Tries ) OR
  966.                ( Ch    = CAN       ) OR
  967.                Stop_Send;
  968.  
  969.          IF ( NOT Display_Status ) THEN
  970.             Flip_Display_Status;
  971.  
  972.          IF Tries = Max_Tries THEN
  973.             Display_Send_Error('No ACK on EOT (end of transmission)', FALSE)
  974.          ELSE IF ( Ch = CAN ) THEN
  975.             Display_Send_Error('Receiver cancelled transmission.' , FALSE)
  976.          ELSE IF ( Alt_S_Pressed OR Stop_Send ) THEN
  977.             Display_Send_Error('Alt-S key hit, send cancelled.',FALSE)
  978.          ELSE
  979.             BEGIN
  980.  
  981.                GoToXY( 26 , 8 );
  982.                WRITE('EOT acknowledged, send complete.');
  983.                ClrEol;
  984.  
  985.                End_Time       := TimeOfDay;
  986.  
  987.                IF End_Time < Start_Time THEN
  988.                   End_Time := End_Time + 86400;
  989.  
  990.                Effective_Rate := End_Time - Start_Time;
  991.  
  992.                IF ( Effective_Rate = 0.0 ) THEN
  993.                   Effective_Rate := 1.0;
  994.  
  995.                Effective_Rate := R_File_Size / Effective_Rate;
  996.  
  997.                Window_Delay;
  998.  
  999.                GoToXY( 26 , 8 );
  1000.                WRITE('Transfer rate was ',Effective_Rate:6:1,' CPS');
  1001.                ClrEol;
  1002.  
  1003.                Write_Log( 'Send completed.', TRUE, FALSE );
  1004.  
  1005.                STR( Effective_Rate:6:1 , SCps );
  1006.                Write_Log('Transfer rate was ' + SCps + ' CPS', TRUE, FALSE );
  1007.  
  1008.             END;
  1009.  
  1010.       END;
  1011.  
  1012.    IF ( NOT Display_Status ) THEN
  1013.       Flip_Display_Status;
  1014.  
  1015.    IF Stop_Send THEN
  1016.       IF Async_Carrier_Drop THEN
  1017.          Display_Send_Error('Carrier dropped.' , FALSE );
  1018.  
  1019.                                       (* Close transferred file           *)
  1020.    CLOSE( XFile );
  1021.    I := Int24Result;
  1022.  
  1023.    Window_Delay;
  1024.                                    (* Remove XMODEM window             *)
  1025.  
  1026.    Restore_Screen_And_Colors( Saved_Screen );
  1027.  
  1028.                                    (* Turn cursor back on *)
  1029.    CursorOn;
  1030.                                    (* Restore XON/XOFF status *)
  1031.  
  1032.    Async_Do_XonXoff := Save_XonXoff;
  1033.  
  1034.                                    (* Restore status line *)
  1035.    IF Do_Status_Line THEN
  1036.       BEGIN
  1037.          Set_Status_Line_Name( Short_Terminal_Name );
  1038.          Write_To_Status_Line( Status_Line_Name, 1 );
  1039.       END;
  1040.  
  1041. END   (* Send_Xmodem_File *);
  1042.