home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBTERM.ZIP / PIBUPDWN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-11-25  |  48.0 KB  |  1,149 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   UPDOWN.PAS --- File Upload/Download Routines for Turbo Pascal      *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*  Date:    January, 1985                                              *)
  7. (*  Version: 1.0                                                        *)
  8. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  9. (*           Note:  I have checked these on Zenith 151s under           *)
  10. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  11. (*  Needs:   The Menu routines from MENUS.PAS, the communications       *)
  12. (*           routines from ASYNC.PAS, and some global variables from    *)
  13. (*           PIBTERM.PAS.                                               *)
  14. (*                                                                      *)
  15. (*  History: Original with me, but the XMODEM is based upon the         *)
  16. (*           famous (X)MODEM(7) programs of Christiansen, et. al.       *)
  17. (*           Note that both the Checksum and CRC versions of XMODEM     *)
  18. (*           are available here.                                        *)
  19. (*                                                                      *)
  20. (*           Suggestions for improvements or corrections are welcome.   *)
  21. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  22. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  23. (*                                                                      *)
  24. (*           If you use this code in your own programs, please be nice  *)
  25. (*           and give proper credit.                                    *)
  26. (*                                                                      *)
  27. (*----------------------------------------------------------------------*)
  28. (*                                                                      *)
  29. (*  Routines:                                                           *)
  30. (*                                                                      *)
  31. (*     DownLoad --- Download a file  (control routine)                  *)
  32. (*     UpLoad   --- Upload a file    (control routine)                  *)
  33. (*                                                                      *)
  34. (*     Receive_Ascii_File --- Receive Ascii file from another computer  *)
  35. (*     Send_Ascii_File    --- Send Ascii file to another computer       *)
  36. (*                                                                      *)
  37. (*     Compute_Crc         --- Compute CRC for XMODEM                   *)
  38. (*     Receive_Xmodem_File --- Receive file with XMODEM                 *)
  39. (*     Send_Xmodem_File    --- Send file with XMODEM                    *)
  40. (*                                                                      *)
  41. (*     Get_File_Transfer_Protocol --- Determines type of transfer       *)
  42. (*                                                                      *)
  43. (*----------------------------------------------------------------------*)
  44.  
  45.                    (* Xmodem Declarations *)
  46. Const
  47.  
  48.    Sector_Size   = 130             (* Xmodem sector size                *);
  49.  
  50.                    (* Special characters used in XMODEM *)
  51.  
  52.    SOH   = $01;                    (* Start of XMODEM block       *)
  53.    EOT   = $04;                    (* End of XMODEM transmission  *)
  54.    ACK   = $06;                    (* Acknowledge an XMODEM block *)
  55.    NAK   = $15;                    (* Refuse an XMODEM block      *)
  56.    CAN   = $18;                    (* Cancel XMODEM transfer      *)
  57.  
  58. Type
  59.  
  60.    Sector_Type   = Array[ 1 .. Sector_Size ] Of Byte;
  61.  
  62. Var
  63.                                    (* One sector of data                *)
  64.    Sector_Data   : Sector_Type;
  65.  
  66.    Sector_Number : Integer         (* Current sector number being sent  *);
  67.  
  68.  
  69.                    (* Transfer Declarations *)
  70. Type
  71.  
  72.    Transfer_Type = ( Ascii, Xmodem_Chk, Xmodem_Crc, None );
  73.    Transfer_Str  = STRING[255];
  74.  
  75. Const
  76.  
  77.    Transfers : Array[ 1 .. 3 ] Of Transfer_Type
  78.                = ( Ascii, Xmodem_Chk, Xmodem_Crc );
  79.  
  80.                    (* Files for transfers *)
  81. Var
  82.  
  83.    AFile      : Text               (* Ascii File uploaded/downloaded    *);
  84.    XFile      : File               (* Xmodem File uploaded/downloaded   *);
  85.    FileName   : String[30]         (* Name of file                      *);
  86.  
  87.  
  88.                    (* Timing/Delay Constants and Variables *)
  89. Const
  90.  
  91.    Ten_Seconds    = 10              (* Ten seconds                      *);
  92.    Twenty_Seconds = 20              (* Twenty seconds                   *);
  93.    One_Second     = 1               (* One second                       *);
  94.  
  95. Var
  96.  
  97.    Char_Delay  : Integer            (* Character delay for Ascii trans.  *);
  98.    Line_Delay  : Integer            (* Line delay for Ascii transfers    *);
  99.    Pacing_Char : Char               (* Pacing character for uploads      *);
  100.  
  101.                    (* Save/restore transmission params during XMODEM *)
  102.  
  103. Var
  104.    Xmodem_Bits_Save:   Integer     (* Save # bits per character         *);
  105.    Xmodem_Parity_Save: Char        (* Save parity                       *);
  106.    Xmodem_Stop_Save:   Integer     (* Save stop bits                    *);
  107.  
  108. (*----------------------------------------------------------------------*)
  109. (*           Compute_CRC --- Compute cyclic redundancy check            *)
  110. (*----------------------------------------------------------------------*)
  111.  
  112. Procedure Compute_Crc(     Sector : Sector_Type;
  113.                        Var HiCrc  : Integer;
  114.                        Var LoCrc  : Integer       );
  115.  
  116.  
  117. (*                                                                      *)
  118. (*     Procedure:  Compute_Crc                                          *)
  119. (*                                                                      *)
  120. (*     Purpose:    Computes cyclic redundancy check for XMODEM sector   *)
  121. (*                                                                      *)
  122. (*     Calling Sequence:                                                *)
  123. (*                                                                      *)
  124. (*        Compute_Crc( Sector : Sector_Type; Var HiCrc: Integer;        *)
  125. (*                     Var LoCrc: Integer );                            *)
  126. (*                                                                      *)
  127. (*           Sector --- 130 byte sector for which CRC is computed.      *)
  128. (*                      The first 128 bytes contain actual data, the    *)
  129. (*                      last two bytes are either zero (when a file is  *)
  130. (*                      being sent) or the CRC for the sector (when a   *)
  131. (*                      file is being received).                        *)
  132. (*           HiCrc  --- High byte of resultant CRC value                *)
  133. (*           LoCrc  --- Low byte of resultant CRC value                 *)
  134. (*                                                                      *)
  135. (*     Remarks:                                                         *)
  136. (*                                                                      *)
  137. (*        The polynomial X^16 + X^12 + X^5 + 1 is used, which should    *)
  138. (*        match that implemented in most other XMODEM programs.         *)
  139. (*                                                                      *)
  140. (*     Calls:    None                                                   *)
  141. (*                                                                      *)
  142.  
  143. Const
  144.    Crc_Poly_Low  = 33;
  145.    Crc_Poly_High = 16;
  146.  
  147. Var
  148.    I:        Integer;
  149.    C:        Integer;
  150.    J:        Integer;
  151.    SaveC:    Integer;
  152.  
  153. Begin (* Compute_Crc *)
  154.  
  155.    HiCrc := 0;
  156.    LoCrc := 0;
  157.  
  158.    For I := 1 To 130 Do
  159.       Begin
  160.  
  161.          C       := ORD( Sector[I] );
  162.  
  163.          For J := 1 To 8 Do
  164.             Begin
  165.  
  166.                C      := C * 2;
  167.                SaveC  := C;
  168.                C      := C AND $FF;
  169.  
  170.                HiCrc  := HICrc * 2;
  171.                LoCrc  := LOCrc * 2;
  172.  
  173.                If SaveC > 255 Then LoCrc := LoCrc OR 1;
  174.                If LoCrc > 255 Then HiCrc := HiCrc OR 1;
  175.  
  176.                If HiCrc > 255 Then
  177.                   Begin
  178.                      HiCrc := HiCrc XOR Crc_Poly_High;
  179.                      LoCrc := LoCrc XOR Crc_Poly_Low;
  180.                   End;
  181.  
  182.                Hicrc := HiCrc AND $FF;
  183.                Locrc := LoCrc AND $FF;
  184.  
  185.             End;
  186.  
  187.       End;
  188.  
  189. End   (* Compute_Crc *);
  190.  
  191. (*----------------------------------------------------------------------*)
  192. (*                Send_Xmodem_File --- Upload file using XMODEM         *)
  193. (*----------------------------------------------------------------------*)
  194.  
  195. Procedure Send_Xmodem_File( Use_CRC : Boolean );
  196.  
  197. (*                                                                      *)
  198. (*     Procedure:  Send_Xmodem_File                                     *)
  199. (*                                                                      *)
  200. (*     Purpose:    Uploads file to remote host using XMODEM protocol.   *)
  201. (*                                                                      *)
  202. (*     Calling Sequence:                                                *)
  203. (*                                                                      *)
  204. (*        Send_Xmodem_File( Use_CRC );                                  *)
  205. (*                                                                      *)
  206. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  207. (*                       of XMODEM; FALSE to use Checksum version.      *)
  208. (*                                                                      *)
  209. (*     Remarks:                                                         *)
  210. (*                                                                      *)
  211. (*        The file's existence should have been already checked         *)
  212. (*        prior to calling this routine.                                *)
  213. (*                                                                      *)
  214. (*        The transmission parameters are automatically set to:         *)
  215. (*                                                                      *)
  216. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  217. (*                                                                      *)
  218. (*        and then they are automatically restored to the previous      *)
  219. (*        values when the transfer is complete.                         *)
  220. (*                                                                      *)
  221. (*     Calls:    KeyPressed                                             *)
  222. (*               Async_Send                                             *)
  223. (*               Async_Receive                                          *)
  224. (*               Compute_Crc                                            *)
  225. (*               Draw_Menu_Frame                                        *)
  226. (*               Save_Screen                                            *)
  227. (*               Restore_Screen                                         *)
  228. (*               Async_Open                                             *)
  229. (*                                                                      *)
  230.  
  231. Const
  232.    Max_Tries     = 10              (* Maximum # of times to try sending *)
  233.                                    (* a given sector                    *);
  234. Var
  235.    I             : Integer         (* Loop index                        *);
  236.    Tries         : Integer         (* # of tries sending current sector *);
  237.    Checksum      : Integer         (* Sector checksum                   *);
  238.    HiCrc         : Integer         (* High byte, cyclic redund. check   *);
  239.    LoCrc         : Integer         (* Low byte, cyclic redund. check    *);
  240.    Ch            : Integer         (* Character received from COM port  *);
  241.    Sector_Length : Integer         (* # chars to send                   *);
  242.    OK_Init       : Boolean         (* Flag for reinitialization of com. *);
  243.    Stop_Send     : Boolean         (* If user cancels sending of file.  *);
  244.    Kbd_Ch        : Char            (* Absorbs keyboard characters       *);
  245.  
  246. Begin (* Send_Xmodem_File *)
  247.                                    (* Reset comm. parameters for XMODEM *)
  248.    Xmodem_Bits_Save   := Data_Bits;
  249.    Xmodem_Parity_Save := Parity;
  250.    Xmodem_Stop_Save   := Stop_Bits;
  251.  
  252.    OK_Init := Async_Open( Comm_Port, Baud_Rate, 'N', 8, 1 );
  253.  
  254.                                    (* Open display window for transfer  *)
  255.    Save_Screen( Saved_Screen );
  256.  
  257.    Draw_Menu_Frame( 15, 10, 68, 21, Menu_Frame_Color,
  258.                     Menu_Text_Color,
  259.                     'Send file ' + FileName + ' using XMODEM' );
  260.  
  261.    Window( 16, 11, 67, 20 );
  262.  
  263.                                    (* Open file to send -- assume OK    *)
  264.    Assign( XFile , FileName );
  265.    Reset( XFile );
  266.                                    (* Determine Sector Size             *)
  267.    If Use_Crc Then
  268.       Sector_Length := 130
  269.    Else
  270.       Sector_Length := 129;
  271.  
  272.                                    (* Sector #s start at 1, wrap at 255 *)
  273.    Sector_Number := 0;
  274.  
  275.                                    (* Purge buffer before sending       *)
  276.    Async_Purge_Buffer;
  277.  
  278.                                    (* Set TRUE if PgUp pressed          *)
  279.    Stop_Send := FALSE;
  280.                                    (* Loop until done (EOT sent) or too *)
  281.                                    (* many errors found.                *)
  282.    Repeat
  283.                                    (* See if PgUp hit, ending transfer  *)
  284.       If KeyPressed Then
  285.          Begin
  286.             Read( Kbd, Kbd_Ch );
  287.             If Kbd_Ch = CHR( 27 ) Then
  288.                Begin
  289.                   Read( Kbd_Ch, Ch );
  290.                   Stop_Send := ( ORD( Kbd_Ch ) = 73 );
  291.                End;
  292.          End;
  293.  
  294.       If Stop_Send Then
  295.          Async_Send( CHR( Can ))
  296.       Else
  297.          Begin (* Send the next sextor *)
  298.  
  299.                                    (* Increment sector number           *)
  300.             Sector_Number := Sector_Number + 1;
  301.  
  302.                                    (* Reset error count to zero         *)
  303.             Tries := 0;
  304.                                    (* Read 128 characters from file to  *)
  305.                                    (* be sent.  Note:  MSDOS files have *)
  306.                                    (* a 128 character sector size.      *)
  307.  
  308.             Blockread( XFile, Sector_Data, 1 );
  309.  
  310.                                    (* Compute Checksum or Crc           *)
  311.             If Use_Crc Then
  312.                Begin (* Use CRC *)
  313.  
  314.                   Sector_Data[ 129 ] := 0;
  315.                   Sector_data[ 130 ] := 0;
  316.  
  317.                   Compute_Crc( Sector_Data , HiCrc, LoCrc );
  318.  
  319.                   Sector_Data[ 129 ] := HiCrc;
  320.                   Sector_Data[ 130 ] := LoCrc;
  321.  
  322.                End   (* Use CRC *)
  323.             Else
  324.                Begin (* Use Checksum *)
  325.  
  326.                   Checksum := 0;
  327.  
  328.                   For I := 1 To ( Sector_Size - 2 ) Do
  329.                      Checksum := ( Checksum + Sector_Data[ I ] ) MOD 256;
  330.  
  331.                   Sector_Data[ 129 ] := Checksum;
  332.  
  333.                End   (* Use Checksum *);
  334.  
  335.                                    (* Begin send loop for this sector.  *)
  336.             Repeat
  337.  
  338.                Writeln( 'Sending sector: ', Sector_Number );
  339.  
  340.                Async_Send( CHR ( SOH ) );
  341.                Async_Send( CHR(       Sector_Number ) );
  342.                Async_Send( CHR( 255 - Sector_Number ) );
  343.  
  344.                                    (* Transmit Sector Data              *)
  345.  
  346.                For I := 1 To Sector_Length Do
  347.                   Async_Send( CHR( Sector_Data[ I ] ) );
  348.  
  349.                                    (* Increment count of tries to send  *)
  350.                                    (* for this sector.                  *)
  351.                Tries := Tries + 1;
  352.  
  353.                                    (* Pick up a character -- should be ACK *)
  354.                Async_Receive_With_Timeout( Ten_Seconds , Ch );
  355.  
  356.             Until ( Ch = ACK ) OR ( Ch = CAN ) OR ( Tries = Max_Tries );
  357.  
  358.  
  359.          End (* Send Next Sector *);
  360.  
  361.    Until ( Eof( XFile ) ) OR ( Tries = Max_Tries ) OR ( Ch = CAN ) OR
  362.          ( Stop_Send );
  363.  
  364.    If Tries = Max_Tries Then   (* We failed to send a sector correctly *)
  365.       Writeln('No ACK for sector ', Sector_Number - 1 )
  366.    Else If ( Ch = CAN ) Then   (* Receiver cancelled transmission *)
  367.       Writeln('Receiver cancelled transmission.')
  368.    Else If Stop_Send Then      (* User cancelled transmission *)
  369.       Writeln('PgUp key hit, transfer cancelled.')
  370.    Else                        (* We sent everything, now try sending EOT *)
  371.       Begin
  372.  
  373.          Tries := 0;
  374.  
  375.          Repeat
  376.             Async_Send( CHR( EOT ) );
  377.             Tries := Tries + 1;
  378.             Async_Receive_With_Timeout( Ten_Seconds , Ch );
  379.          Until ( Ch = ACK ) OR ( Tries = Max_Tries ) OR ( Ch = CAN );
  380.  
  381.          If Tries = Max_Tries Then
  382.             Writeln('No ACK on EOT (end of transmission)')
  383.          Else If ( Ch = CAN ) Then
  384.             Writeln('Receiver cancelled transmission.')
  385.          Else
  386.             Writeln('EOT acknowledged, transfer complete');
  387.  
  388.       End;
  389.                                    (* Close transferred file           *)
  390.    Close( XFile );
  391.                                    (* Reset comm parms to saved values *)
  392.  
  393.    OK_Init := Async_Open( Comm_Port, Baud_Rate, Xmodem_Parity_Save,
  394.                           Xmodem_Bits_Save, Xmodem_Stop_Save );
  395.  
  396.                                    (* Remove XMODEM window             *)
  397.    Restore_Screen( Saved_Screen );
  398.  
  399.    Reset_Global_Colors;
  400.  
  401. End   (* Send_Xmodem_File *);
  402.  
  403. (*----------------------------------------------------------------------*)
  404. (*           Receive_Xmodem_File --- Download file using XMODEM         *)
  405. (*----------------------------------------------------------------------*)
  406.  
  407. Procedure Receive_Xmodem_File( Use_CRC : Boolean );
  408.  
  409. (*                                                                      *)
  410. (*     Procedure:  Receive_Xmodem_File                                  *)
  411. (*                                                                      *)
  412. (*     Purpose:    Downloads file from remote host using XMODEM         *)
  413. (*                 protocol.                                            *)
  414. (*                                                                      *)
  415. (*     Calling Sequence:                                                *)
  416. (*                                                                      *)
  417. (*        Receive_Xmodem_File( Use_CRC );                               *)
  418. (*                                                                      *)
  419. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  420. (*                       of XMODEM; FALSE to use Checksum version.      *)
  421. (*                                                                      *)
  422. (*     Remarks:                                                         *)
  423. (*                                                                      *)
  424. (*        The transmission parameters are automatically set to:         *)
  425. (*                                                                      *)
  426. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  427. (*                                                                      *)
  428. (*        and then they are automatically restored to the previous      *)
  429. (*        values when the transfer is complete.                         *)
  430. (*                                                                      *)
  431. (*                                                                      *)
  432. (*     Calls:   KeyPressed                                              *)
  433. (*              Async_Send                                              *)
  434. (*              Async_Receive                                           *)
  435. (*              Compute_Crc                                             *)
  436. (*                                                                      *)
  437.  
  438. Const
  439.    Max_Errors     = 10              (* Maximum errors before aborting   *)
  440.                                     (* reception                        *);
  441. Var
  442.    Sector_Count  : Integer         (* Sector count -- no wrap at 255    *);
  443.    Sector_Comp   : Byte            (* Complement of current sector #    *);
  444.    Sector_Prev   : Byte            (* Previous sector number            *);
  445.    I             : Integer         (* Loop index                        *);
  446.    Checksum      : Integer         (* Sector checksum                   *);
  447.    HiCrc         : Integer         (* High byte, cyclic redund. check   *);
  448.    LoCrc         : Integer         (* Low byte, cyclic redund. check    *);
  449.    Error_count   : Integer         (* # of errors encountered           *);
  450.    Ch            : Integer         (* Character read from COM port      *);
  451.    Error_Flag    : Boolean         (* If an error is found              *);
  452.    Initial_Ch    : Integer         (* Initial character                 *);
  453.    Sector_Length : Integer         (* Sector Length                     *);
  454.    Checksum_OK   : Boolean         (* CRC/Checksum is OK                *);
  455.    OK_Init       : Boolean         (* Flag for reinitialization of com. *);
  456.    Sector_Prev1  : Byte            (* Previous sector + 1               *);
  457.    Stop_Receive  : Boolean         (* TRUE if transfer to be stopped    *);
  458.    Kbd_Ch        : Char            (* Absorbs KeyPressed Characters     *);
  459.  
  460. Begin  (* Receive_Xmodem_File *)
  461.  
  462.                                    (* Reset comm. parameters for XMODEM *)
  463.    Xmodem_Bits_Save   := Data_Bits;
  464.    Xmodem_Parity_Save := Parity;
  465.    Xmodem_Stop_Save   := Stop_Bits;
  466.  
  467.    OK_Init := Async_Open( Comm_Port, Baud_Rate, 'N', 8, 1 );
  468.  
  469.                                    (* Open display window for transfer  *)
  470.    Save_Screen( Saved_Screen );
  471.  
  472.    Draw_Menu_Frame( 15, 10, 68, 21, Menu_Frame_Color,
  473.                     Menu_Text_Color,
  474.                     'Receive file ' + FileName + ' using XMODEM' );
  475.  
  476.    Window( 16, 11, 67, 20 );
  477.                                    (* Open reception file *)
  478.    Assign( XFile , FileName );
  479.    Rewrite( XFile );
  480.                                    (* Current sector = 0 *)
  481.    Sector_Number := 0;
  482.    Sector_Count  := 0;
  483.    Sector_Prev   := 0;
  484.                                    (* Overall error count = 0 *)
  485.    Error_Count   := 0;
  486.                                    (* Fire up XMODEM *)
  487.    If Use_Crc Then
  488.       Async_Send( 'C' )
  489.    Else
  490.       Async_Send( CHR( NAK ) );
  491.  
  492.                                    (* User intervention flag *)
  493.    Stop_Receive := FALSE;
  494.  
  495.    Repeat
  496.                                    (* Reset error flag *)
  497.       Error_flag := FALSE;
  498.                                    (* Look for SOH     *)
  499.       Repeat
  500.  
  501.          Async_Receive_With_Timeout( Twenty_Seconds, Initial_Ch );
  502.  
  503.          If KeyPressed Then
  504.             Begin
  505.                Read( Kbd, Kbd_Ch );
  506.                If Kbd_Ch = CHR( 27 ) Then
  507.                  Begin
  508.                     Read( Kbd, Kbd_Ch );
  509.                     Stop_Receive := ( ORD( Kbd_Ch ) = 81 );
  510.                  End;
  511.             End;
  512.  
  513.       Until ( Initial_Ch = SOH     ) OR
  514.             ( Initial_Ch = EOT     ) OR
  515.             ( Initial_Ch = CAN     ) OR
  516.             ( Initial_Ch = TimeOut ) OR
  517.             ( Stop_Receive         );
  518.  
  519.                                    (* KeyBoard input -- send CAN *)
  520.       If Stop_Receive Then
  521.          Begin
  522.             Async_Send( CHR( CAN ) );
  523.          End
  524.                                    (* Timed out -- no SOH found *)
  525.       Else If Initial_Ch = Timeout Then
  526.          Writeln( 'Error - No starting SOH, reception cancelled.')
  527.  
  528.                                    (* SOH found -- start of XMODEM block *)
  529.       Else If Initial_Ch = SOH Then
  530.          Begin (* SOH found *)
  531.                                    (* Pick up sector number *)
  532.  
  533.             Async_Receive_With_Timeout( One_Second , Ch );
  534.             Sector_Number := Ch;
  535.                                    (* Complement of sector number *)
  536.  
  537.             Async_Receive_With_Timeout( One_Second , Ch );
  538.             Sector_Comp := Ch;
  539.  
  540.                                    (* See if they add up properly     *)
  541.  
  542.             If ( ( Sector_Number + Sector_Comp ) = 255 ) Then
  543.  
  544.                Begin  (* Sector number and complement match *)
  545.  
  546.                   Sector_Prev1 := Sector_Prev + 1;
  547.  
  548.                   If ( Sector_Number = Sector_Prev1 ) Then
  549.  
  550.                      Begin  (* Correct sector found *)
  551.  
  552.                                    (* Pick up sector data, calculate *)
  553.                                    (* checksum or CRC *)
  554.  
  555.                         Checksum_OK := False;
  556.  
  557.                         For I := 1 to ( Sector_Size - 2 ) Do
  558.                             Begin
  559.                                Async_Receive_With_Timeout( One_Second , Ch );
  560.                                Sector_Data[I] := Ch;
  561.                             End;
  562.  
  563.                         If Use_Crc Then
  564.                            Begin   (* Compute CRC *)
  565.  
  566.                               Async_Receive_With_Timeout( One_Second , Ch );
  567.                               If Ch <> Timeout Then
  568.                                  Begin
  569.                                     Sector_Data[ 129 ] := Ch;
  570.                                     Async_Receive_With_Timeout( One_Second , Ch );
  571.                                     If Ch <> Timeout Then
  572.                                        Begin
  573.                                           Sector_Data[ 130 ] := Ch;
  574.                                           Compute_Crc( Sector_data , HiCrc, LoCrc );
  575.                                           Checksum_OK := ( HiCrc = 0 ) AND
  576.                                                          ( LoCrc = 0 );
  577.                                        End;
  578.                                  End;
  579.  
  580.                            End     (* Compute CRC *)
  581.  
  582.                         Else
  583.                            Begin   (* Compute Checksum *)
  584.  
  585.                               Checksum := 0;
  586.  
  587.                               For I := 1 to ( Sector_Size - 2 ) Do
  588.                                  Checksum := ( Checksum + Sector_Data[I] ) AND 255;
  589.  
  590.                                    (* Read sector checksum, see if it matches *)
  591.                                    (* what we computed from sector read.      *)
  592.  
  593.                               Async_Receive_With_Timeout( One_Second , Ch );
  594.  
  595.                               Checksum_OK := ( Checksum = Ch );
  596.  
  597.                            End    (* Compute Checksum *);
  598.  
  599.                         If Checksum_OK Then
  600.                            Begin (* Checksum/CRC OK *)
  601.  
  602.                               Blockwrite( XFile, Sector_Data, 1 );
  603.  
  604.                               Error_Count  := 0;
  605.  
  606.                               Sector_Count := Sector_Count + 1;
  607.  
  608.                               Writeln('Received sector ',Sector_Count);
  609.  
  610.                               Sector_Prev := Sector_Number;
  611.  
  612.                               Async_Send( CHR( ACK ) );
  613.  
  614.                            End   (* Checksum/CRC OK *)
  615.                         Else
  616.                            Begin  (* Checksum/CRC error *)
  617.                               If Use_Crc Then
  618.                                  Writeln('CRC Error --- Hi = ',HiCrc,
  619.                                           '  Lo = ',LoCrc)
  620.                               Else
  621.                                  Writeln('Checksum Error');
  622.                               Error_Flag := TRUE;
  623.                            End    (* Checksum/CRC error *)
  624.  
  625.                      End  (* Correct sector found *)
  626.  
  627.                   Else
  628.                      If ( Sector_Number = Sector_Prev ) Then
  629.                         Begin  (* Duplicate sector *)
  630.  
  631.                            Repeat
  632.                               Async_Receive_With_Timeout( One_Second , Ch );
  633.                            Until ( Ch = TimeOut );
  634.  
  635.                            Writeln('Received duplicate sector ', Sector_Number );
  636.                            Async_send( CHR( ACK ) );
  637.  
  638.                         End   (* Duplicate sector *)
  639.                   Else
  640.                      Begin
  641.                         Writeln('Synchronization error');
  642.                         Error_Flag := TRUE;
  643.                      End;
  644.  
  645.                End   (* Sector # and complement match *)
  646.  
  647.             Else
  648.                Begin (* Sector # and complement do not match *)
  649.                   Writeln('Sector number error');
  650.                   Error_Flag := TRUE
  651.                End   (* Sector # and complement do not match *);
  652.  
  653.          End (* SOH Found *);
  654.  
  655.          If Error_Flag Then
  656.             Begin
  657.                Error_Count := Error_Count + 1;
  658.                Repeat
  659.                   Async_Receive_With_Timeout( One_Second , Ch );
  660.                Until ( Ch = TimeOut );
  661.                Async_Send( CHR( NAK ) );
  662.             End;
  663.  
  664.    Until ( Initial_Ch = EOT     ) OR
  665.          ( Initial_Ch = TimeOut ) OR
  666.          ( Initial_Ch = CAN     ) OR
  667.          ( Stop_Receive         ) OR
  668.          ( Error_Count >= Max_Errors );
  669.  
  670.    If ( Initial_Ch = EOT ) AND ( Error_Count < Max_Errors ) Then
  671.       Begin
  672.          Async_Send( CHR( ACK ) );
  673.          Writeln('Transfer complete');
  674.       End
  675.    Else If ( Initial_Ch = CAN ) Then
  676.       Writeln('Transmitter cancelled file transfer.')
  677.    Else If ( Stop_Receive ) Then
  678.       Writeln('PdDn key hit -- reception cancelled.')
  679.    Else
  680.       Writeln('Transfer Cancelled');
  681.  
  682.                                    (* Close transferred file *)
  683.    Close( XFile );
  684.                                    (* Reset comm parms to saved values *)
  685.  
  686.    OK_Init := Async_Open( Comm_Port, Baud_Rate, Xmodem_Parity_Save,
  687.                           Xmodem_Bits_Save, Xmodem_Stop_Save );
  688.  
  689.                                    (* Remove XMODEM window             *)
  690.    Restore_Screen( Saved_Screen );
  691.  
  692.    Reset_Global_Colors;
  693.  
  694. End    (* Receive_Xmodem_File *) ;
  695.  
  696. (*----------------------------------------------------------------------*)
  697. (*                Receive_Ascii_File --- Download ASCII file            *)
  698. (*----------------------------------------------------------------------*)
  699.  
  700. Procedure Receive_Ascii_File;
  701.  
  702. (*                                                                      *)
  703. (*     Procedure:  Receive_Ascii_File                                   *)
  704. (*                                                                      *)
  705. (*     Purpose:    Downloads ASCII file to PC                           *)
  706. (*                                                                      *)
  707. (*     Calling Sequence:                                                *)
  708. (*                                                                      *)
  709. (*        Receive_Ascii_File;                                           *)
  710. (*                                                                      *)
  711. (*     Calls:   KeyPressed                                              *)
  712. (*              Async_Send                                              *)
  713. (*              Async_Receive                                           *)
  714. (*              Async_Percentage_Used                                   *)
  715. (*                                                                      *)
  716. (*     Remarks:                                                         *)
  717. (*                                                                      *)
  718. (*        XON/XOFF is assumed to be supported by the host.              *)
  719. (*                                                                      *)
  720.  
  721. Var
  722.    Ch        : Char;
  723.    Fin       : Boolean;
  724.    XOFF_Sent : Boolean             (* TRUE if XOFF sent to host *);
  725.    X, Y: Integer;
  726.    N_Xoff: Integer;
  727. Begin (* Receive_Ascii_File *)
  728.  
  729.    Fin       := FALSE;
  730.    XOFF_Sent := FALSE;
  731.    N_Xoff    := 0;
  732.  
  733.    Repeat
  734.  
  735.       If Async_Percentage_Used > 0.75 Then
  736.          Begin  (* Buffer too full -- send XOFF if we already haven't *)
  737.             If ( NOT XOFF_Sent ) Then
  738.                Begin
  739.                   Async_Send( CHR( XOFF ) );
  740.                   XOFF_Sent := TRUE;
  741.                   X := WhereX;
  742.                   Y := WhereY;
  743.                   GoToXY( 1 , 25 );
  744.                   TextColor( Red );
  745.                   Write(' Xoff sent, percentage = ',Async_Percentage_Used );
  746.                   TextColor( Yellow );
  747.                   GoToXY( X , Y );
  748.                   N_Xoff := N_Xoff + 1;
  749.                End
  750.          End    (* Buffer too full *)
  751.       Else If Async_Percentage_Used < 0.25 Then
  752.          Begin  (* Buffer reasonably empty -- send XON if needed *)
  753.             If XOFF_Sent Then
  754.                Begin
  755.                   Async_Send( CHR( XON ) );
  756.                   XOFF_Sent := FALSE;
  757.                   X := WhereX;
  758.                   Y := WhereY;
  759.                   GoToXY( 1 , 25 );
  760.                   TextColor( Red );
  761.                   Write(' Xon  sent, percentage = ',Async_Percentage_Used );
  762.                   TextColor( Yellow );
  763.                   GoToXY( X , Y );
  764.                End;
  765.          End;
  766.  
  767.       If KeyPressed Then
  768.          Begin
  769.             Read( Kbd , Ch );
  770.             If Ch = CHR(27) Then
  771.                Begin
  772.                   Read( kbd , Ch );
  773.                   If ORD( Ch ) = 81 Then
  774.                      Fin := TRUE;
  775.                End
  776.             Else
  777.                Async_Send( Ch );
  778.          End;
  779.  
  780.       If Async_Receive( Ch ) Then
  781.          Begin
  782.             Write( AFile , Ch );
  783.             Write( Ch );
  784.          End;
  785.  
  786.    Until ( Fin );
  787.  
  788.    Save_Screen( Saved_Screen );
  789.  
  790.    Draw_Menu_Frame( 5, 5, 55, 10, Menu_Frame_Color,
  791.                     Menu_Text_Color, '' );
  792.  
  793.    Writeln;
  794.    Writeln('Finished receiving ASCII file ',FileName);
  795.    Writeln('Number of XOFFs sent: ',N_Xoff);
  796.    Delay( 2000 );
  797.  
  798.    Close( AFile );
  799.                                    (* Remove this window            *)
  800.    Restore_Screen( Saved_Screen );
  801.  
  802.    Reset_Global_Colors;
  803.  
  804. End   (* Receive_Ascii_File *);
  805.  
  806. (*----------------------------------------------------------------------*)
  807. (*                Send_Ascii_File --- Upload ASCII file                 *)
  808. (*----------------------------------------------------------------------*)
  809.  
  810. Procedure Send_Ascii_File;
  811.  
  812. (*                                                                      *)
  813. (*     Procedure:  Send_Ascii_File                                      *)
  814. (*                                                                      *)
  815. (*     Purpose:    Uploads ASCII file to remote host                    *)
  816. (*                                                                      *)
  817. (*     Calling Sequence:                                                *)
  818. (*                                                                      *)
  819. (*        Send_Ascii_File;                                              *)
  820. (*                                                                      *)
  821. (*     Calls:   KeyPressed                                              *)
  822. (*              Async_Send_String                                       *)
  823. (*              Async_Receive                                           *)
  824. (*                                                                      *)
  825.  
  826. Var
  827.    Ch         : Char;
  828.    Fin        : Boolean;
  829.    TextLine   : String[255];
  830.    Esc_Found  : Boolean;
  831.    B          : Boolean;
  832.    Pace_Found : Boolean;
  833.  
  834. Begin (* Send_Ascii_File *)
  835.                                    (* FIN is true when upload complete *)
  836.    Fin := False;
  837.  
  838.    Repeat
  839.                                    (* Read a line from the file to upload *)
  840.       Readln( AFile , TextLine );
  841.       TextLine := TextLine + CHR( 13 );
  842.  
  843.                                    (* If pacing character specified, wait *)
  844.                                    (* for it to show up from com port     *)
  845.       Esc_Found  := FALSE;
  846.       Pace_Found := FALSE;
  847.  
  848.       If Pacing_Char <> CHR( NUL ) Then
  849.          Repeat
  850.             If KeyPressed Then
  851.                Begin
  852.                   Read( Kbd, Ch );
  853.                   If Ch = CHR( 27 ) Then
  854.                      Esc_Found := TRUE
  855.                   Else
  856.                      Async_Send( Ch );
  857.                End;
  858.             If Async_Buffer_Check Then
  859.                Begin
  860.                   B := Async_Receive( Ch );
  861.                   Write( Ch );
  862.                   Pace_Found := ( Ch = Pacing_Char );
  863.                End;
  864.          Until ( Pace_Found OR Esc_Found )
  865.       Else
  866.          Repeat
  867.             If KeyPressed Then
  868.                Begin
  869.                   Read( Kbd, Ch );
  870.                   If Ch = CHR( 27 ) Then
  871.                      Esc_Found := TRUE
  872.                   Else
  873.                      Async_Send( Ch );
  874.                End;
  875.             If Async_Buffer_Check Then
  876.                Begin
  877.                   B := Async_Receive( Ch );
  878.                   Write( Ch );
  879.                   Pace_Found := ( Ch = CHR( 13 ) );
  880.                End;
  881.          Until ( Pace_Found OR Esc_Found );
  882.  
  883.                                    (* Check if PgUp hit again --  *)
  884.                                    (* end transfer if so.         *)
  885.       If ( KeyPressed OR Esc_Found ) Then
  886.          Begin
  887.             Read( Kbd , Ch );
  888.             If Ch = CHR( 27 ) Then
  889.                Begin
  890.                   Read( Kbd , Ch );
  891.                   If ORD( Ch ) = 73 Then
  892.                      Fin := TRUE
  893.                   Else
  894.                      Begin
  895.                         Async_Send( CHR( 27 ) );
  896.                         Async_Send( Ch );
  897.                      End;
  898.                End
  899.             Else
  900.                Async_Send( Ch );
  901.          End;
  902.                                    (* Send the next line to the host *)
  903.  
  904.       If ( NOT Fin ) Then
  905.          Async_Send_String_With_Delays( TextLine, Char_Delay, Line_Delay );
  906.  
  907.    Until ( Fin OR EOF( AFile ) );
  908.  
  909.    Save_Screen( Saved_Screen );
  910.  
  911.    Draw_Menu_Frame( 5, 5, 55, 10, Menu_Frame_Color,
  912.                     Menu_Text_Color, '' );
  913.  
  914.    Writeln;
  915.    Writeln('Finished Sending ASCII file ',FileName);
  916.    Delay( 2000 );
  917.  
  918.    Close( AFile );
  919.  
  920.                                    (* Remove this window            *)
  921.    Restore_Screen( Saved_Screen );
  922.  
  923.    Reset_Global_Colors;
  924.  
  925. End   (* Send_Ascii_File *);
  926.  
  927. (*----------------------------------------------------------------------*)
  928. (*                DownLoad --- Download a file from a remote host       *)
  929. (*----------------------------------------------------------------------*)
  930.  
  931. Procedure DownLoad( Transfer_Protocol : Transfer_Type ) ;
  932.  
  933. (*                                                                      *)
  934. (*     Procedure:  Download                                             *)
  935. (*                                                                      *)
  936. (*     Purpose:    Controls downloading of files from remote hosts.     *)
  937. (*                                                                      *)
  938. (*     Calling Sequence:                                                *)
  939. (*                                                                      *)
  940. (*        DownLoad( Transfer_Protocol : Transfer_Type );                *)
  941. (*                                                                      *)
  942. (*           Transfer_Protocol --- the type of transfer protocol        *)
  943. (*                                  be used.                            *)
  944. (*     Remarks:                                                         *)
  945. (*                                                                      *)
  946. (*        Currently, the only available protocols are:                  *)
  947. (*                                                                      *)
  948. (*           Ascii file transfer (no error-correction)                  *)
  949. (*           Xmodem with Checksum                                       *)
  950. (*           Xmodem with CRC                                            *)
  951. (*                                                                      *)
  952. (*      Calls:   Receive_Ascii_File                                     *)
  953. (*               Receive_Xmodem_File                                    *)
  954. (*                                                                      *)
  955.  
  956.  
  957. Begin (* DownLoad *)
  958.  
  959.    Case Transfer_Protocol Of
  960.       Ascii:      Receive_Ascii_File;
  961.       Xmodem_Chk: Receive_Xmodem_File( FALSE );
  962.       Xmodem_Crc: Receive_Xmodem_File( TRUE  );
  963.       Else ;
  964.    End  (* Case *);
  965.  
  966. End   (* DownLoad *);
  967.  
  968. (*----------------------------------------------------------------------*)
  969. (*                UpLoad --- Upload a file to a remote host             *)
  970. (*----------------------------------------------------------------------*)
  971.  
  972. Procedure UpLoad( Transfer_Protocol : Transfer_Type ) ;
  973.  
  974. (*                                                                      *)
  975. (*     Procedure:  Upload                                               *)
  976. (*                                                                      *)
  977. (*     Purpose:    Controls uploading of files to remote hosts.         *)
  978. (*                                                                      *)
  979. (*     Calling Sequence:                                                *)
  980. (*                                                                      *)
  981. (*        UpLoad( Transfer_Protocol : Transfer_Type );                  *)
  982. (*                                                                      *)
  983. (*           Transfer_Protocol --- the type of transfer protocol        *)
  984. (*                                  be used.                            *)
  985. (*     Remarks:                                                         *)
  986. (*                                                                      *)
  987. (*        Currently, the only available protocols are:                  *)
  988. (*                                                                      *)
  989. (*           Ascii file transfer (no error-correction)                  *)
  990. (*           Xmodem with Checksum                                       *)
  991. (*           Xmodem with CRC                                            *)
  992. (*                                                                      *)
  993. (*      Calls:   Send_Ascii_File                                        *)
  994. (*               Send_Xmodem_File                                       *)
  995. (*                                                                      *)
  996.  
  997. Begin (* UpLoad *)
  998.  
  999.    Case Transfer_Protocol Of
  1000.       Ascii:      Send_Ascii_File;
  1001.       Xmodem_Chk: Send_Xmodem_File( FALSE );
  1002.       Xmodem_Crc: Send_Xmodem_File( TRUE  );
  1003.       Else ;
  1004.    End  (* Case *);
  1005.  
  1006.    If Transfer_Protocol <> None Then Close( AFile );
  1007.  
  1008. End   (* UpLoad *);
  1009.  
  1010. (*----------------------------------------------------------------------*)
  1011. (*   Get_File_Transfer_Protocol --- Get File Transfer Protocol          *)
  1012. (*----------------------------------------------------------------------*)
  1013.  
  1014. Function Get_File_Transfer_Protocol( Transfer_direction: Transfer_Str )
  1015.          : Transfer_Type ;
  1016.  
  1017. (*                                                                      *)
  1018. (*     Function:   Get_File_Transfer_Protocol                           *)
  1019. (*                                                                      *)
  1020. (*     Purpose:    Gets file name and transfer protocol for upload/     *)
  1021. (*                 download.                                            *)
  1022. (*                                                                      *)
  1023. (*     Calling Sequence:                                                *)
  1024. (*                                                                      *)
  1025. (*        Transtyp := Get_File_Transfer_Protocol( Transfer_Direction:   *)
  1026. (*                    Transfer_Str ) : Transfer_Type;                   *)
  1027. (*                                                                      *)
  1028. (*                                                                      *)
  1029. (*     Remarks:                                                         *)
  1030. (*                                                                      *)
  1031. (*     Calls:    KeyPressed                                             *)
  1032. (*               Async_Send                                             *)
  1033. (*               Async_Receive                                          *)
  1034. (*                                                                      *)
  1035.  
  1036. Var
  1037.    Transfer_Kind : Transfer_Type;
  1038.    Transfer_Menu : Menu_Type;
  1039.    I             : Integer;
  1040.    Pacing_String : String[1];
  1041.  
  1042. Begin (* Get_File_Transfer_Protocol *)
  1043.  
  1044.    Transfer_Menu.Menu_Size    := 3;
  1045.    Transfer_Menu.Menu_Default := 1;
  1046.    Transfer_Menu.Menu_Row     := 11;
  1047.    Transfer_Menu.Menu_Column  := 20;
  1048.    Transfer_Menu.Menu_Tcolor  := Menu_Text_Color;
  1049.    Transfer_Menu.Menu_Bcolor  := BackGround_Color;
  1050.    Transfer_Menu.Menu_Fcolor  := Menu_Frame_Color;
  1051.    Transfer_Menu.Menu_Width   := 50;
  1052.    Transfer_Menu.Menu_Height  := 10;
  1053.  
  1054.    For I := 1 To 3 Do
  1055.       With Transfer_Menu.Menu_Entries[I] Do
  1056.       Begin
  1057.          Menu_Item_Row    := I;
  1058.          Menu_Item_Column := 2;
  1059.          Case I Of
  1060.             1:  Menu_Item_Text := 'Ascii';
  1061.             2:  Menu_Item_Text := 'Xmodem (Checksum)';
  1062.             3:  Menu_Item_Text := 'Xmodem (CRC)';
  1063.          End (* Case *);
  1064.       End;
  1065.  
  1066.    Transfer_Menu.Menu_Title := 'Choose file transfer protocol for ' +
  1067.                                Transfer_Direction + ':';
  1068.  
  1069.    Menu_Display_Choices( Transfer_Menu );
  1070.    Transfer_Kind := Transfers[ Menu_Get_Choice( Transfer_Menu ,
  1071.                                                 Dont_Erase_Menu ) ];
  1072.  
  1073.    GoToXY( 2 , 5 );
  1074.    Write('Filename.Ext ? ');
  1075.    Readln(FileName);
  1076.  
  1077.    Assign(AFile,FileName);
  1078.    If Transfer_direction[1] = 'r' Then
  1079.       (*$I- *)
  1080.          Rewrite(AFile)
  1081.       (*$I+ *)
  1082.    Else
  1083.       (*$I- *)
  1084.          Reset(AFile);
  1085.       (*$I+ *)
  1086.  
  1087.    If IOResult <> 0 Then
  1088.       Begin
  1089.          Transfer_Kind := None;
  1090.          Case Transfer_Direction[1] Of
  1091.             'r' : Writeln('*** Can''t open output file, download cancelled ***');
  1092.             's' : Writeln('*** File to send doesn''t exist, upload cancelled ***');
  1093.          End (* Case *);
  1094.       End;
  1095.  
  1096.                                    (* Get delays for Ascii transfers *)
  1097.    Char_Delay := 0;
  1098.    Line_Delay := 0;
  1099.  
  1100.    Case Transfer_Kind Of
  1101.  
  1102.       Xmodem_Crc,
  1103.       Xmodem_Chk  :  Close( AFile );
  1104.  
  1105.       Ascii       :  If Transfer_Direction[1] = 's' Then
  1106.                         Begin
  1107.                            GoToXY( 2 , 6 );
  1108.                            Write('Delay between characters (milliseconds)? ');
  1109.                            Readln( Char_Delay );
  1110.                            GoToXY( 2 , 7 );
  1111.                            Write('Delay between lines (milleseconds)?      ');
  1112.                            Readln( Line_Delay );
  1113.                            GoToXY( 2 , 8 );
  1114.                            Write('Pacing character?                        ');
  1115.                            Readln( Pacing_String );
  1116.                            If LENGTH( Pacing_String ) > 0 Then
  1117.                               Pacing_Char := Pacing_String[1]
  1118.                            Else
  1119.                               Pacing_Char := CHR( NUL );
  1120.                            GoToXY( 2 , 9 );
  1121.                            Write('Sending file ', FileName );
  1122.                            GoToXY( 2 , 10 );
  1123.                            Write('Hit PgUp to stop transfer.');
  1124.                            Delay( 3000 );
  1125.                         End
  1126.                      Else
  1127.                         Begin
  1128.                            GoToXY( 2 , 6 );
  1129.                            Write('Receiving file ', FileName );
  1130.                            GoToXY( 2 , 7 );
  1131.                            Write('Hit PgUp to stop transfer.');
  1132.                            Delay( 3000 );
  1133.                         End;
  1134.  
  1135.       None        : ;
  1136.  
  1137.    End (* Case *);
  1138.  
  1139.                                    (* Return transfer protocol type *)
  1140.    Get_File_Transfer_Protocol := Transfer_Kind;
  1141.  
  1142.    Delay( 3000 );
  1143.                                    (* Remove this window            *)
  1144.    Restore_Screen( Saved_Screen );
  1145.  
  1146.    Reset_Global_Colors;
  1147.  
  1148. End   (* Get_File_Transfer_Protocol *);
  1149.