home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBT41S4.ZIP / RECEIVX1.MOD < prev    next >
Encoding:
Text File  |  1988-03-23  |  38.9 KB  |  1,042 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           Receive_Xmodem_File --- Download file using XMODEM         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Receive_Xmodem_File( Use_CRC : BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Receive_Xmodem_File                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Downloads file from remote host using XMODEM         *)
  12. (*                 protocol.                                            *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Receive_Xmodem_File( Use_CRC );                               *)
  17. (*                                                                      *)
  18. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  19. (*                       of XMODEM; FALSE to use Checksum version.      *)
  20. (*                                                                      *)
  21. (*     Remarks:                                                         *)
  22. (*                                                                      *)
  23. (*        The transmission parameters are automatically set to:         *)
  24. (*                                                                      *)
  25. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  26. (*                                                                      *)
  27. (*        and then they are automatically restored to the previous      *)
  28. (*        values when the transfer is complete.                         *)
  29. (*                                                                      *)
  30. (*        This code actually controls file reception using any of the   *)
  31. (*        Xmodem-based protocols:  Xmodem, Modem7, Telink, and Ymodem.  *)
  32. (*                                                                      *)
  33. (*     Calls:   PibTerm_KeyPressed                                      *)
  34. (*              Async_Send                                              *)
  35. (*              Async_Receive                                           *)
  36. (*              Async_Receive_With_TimeOut                              *)
  37. (*              Async_Purge_Buffer                                      *)
  38. (*              Update_Xmodem_Receive_Display                           *)
  39. (*              Display_Receive_Error                                   *)
  40. (*              Receive_Xmodem_Sector                                   *)
  41. (*              Receive_Telink_Header                                   *)
  42. (*              Receive_Ymodem_Header                                   *)
  43. (*              Wait_For_SOH                                            *)
  44. (*              Set_File_Date_And_Time                                  *)
  45. (*              Draw_Menu_Frame                                         *)
  46. (*              Open_Receiving_File                                     *)
  47. (*                                                                      *)
  48. (*----------------------------------------------------------------------*)
  49.  
  50. CONST
  51.    XOFF_Delay    = 250             (* WXModem XOFF delay time           *);
  52.    WXmodem_Flush = 4               (* Blocks to flush when error        *);
  53.    SEALink_Flush = 6               (* Blocks to flush when error        *);
  54.  
  55. VAR
  56.    Sector_Count  : INTEGER         (* Sector count -- no wrap at 255    *);
  57.    Sector_Comp   : BYTE            (* Complement of current sector #    *);
  58.    Sector_Prev   : BYTE            (* Previous sector number            *);
  59.    I             : INTEGER         (* Loop index                        *);
  60.    Error_Count   : INTEGER         (* # of errors encountered           *);
  61.    Ch            : INTEGER         (* Character read from COM port      *);
  62.    Error_Flag    : BOOLEAN         (* IF an error is found              *);
  63.    Initial_Ch    : INTEGER         (* Initial character                 *);
  64.    Sector_Length : INTEGER         (* Sector Length                     *);
  65.    Sector_Prev1  : BYTE            (* Previous sector + 1               *);
  66.    BlockL_Errors : INTEGER         (* Counts block length errors        *);
  67.    SOH_Errors    : INTEGER         (* Counts SOH errors                 *);
  68.    BlockN_Errors : INTEGER         (* Counts block number errors        *);
  69.    Comple_Errors : INTEGER         (* Counts complement errors          *);
  70.    TimeOut_Errors: INTEGER         (* Counts timeout errors             *);
  71.    Resend_Errors : INTEGER         (* Counts resend block errors        *);
  72.    CRC_Errors    : INTEGER         (* Counts checksum/crc errors        *);
  73.    Effective_Rate: REAL            (* Effective baud rate of transfer   *);
  74.    CRC_Tries     : INTEGER         (* Initial CRC tries                 *);
  75.    WXM_Tries     : INTEGER         (* Initial WXModem tries             *);
  76.    SOH_Time      : INTEGER         (* Seconds to wait for SOH           *);
  77.    RFile_Size    : LONGINT         (* Actual file size                  *);
  78.    RFile_Date    : LONGINT         (* File date/time                    *);
  79.    File_Date     : WORD            (* MS DOS encoded file date          *);
  80.    File_Time     : WORD            (* MS DOS encoded file time          *);
  81.    RFile_Name    : AnyStr          (* Received file name, Ymodem        *);
  82.    Truncate_File : BOOLEAN         (* TRUE to trunc. file to exact size *);
  83.    RFile_Open    : BOOLEAN         (* TRUE if receiving file opened     *);
  84.    XFile_Byte    : FILE OF BYTE    (* For truncating received file      *);
  85.    OK_Transfer   : BOOLEAN         (* If transfer OK                    *);
  86.    Block_Zero    : BOOLEAN         (* If block 0 encountered            *);
  87.  
  88.    RFile_Size_2  : LONGINT         (* File size from totalling sectors  *);
  89.  
  90.    Write_Count   : INTEGER         (* Number of bytes to write          *);
  91.    Err           : INTEGER         (* Error flag for handle I/O         *);
  92.  
  93.                                    (* Write buffer pointer              *)
  94.    Write_Buffer  : File_Handle_Buffer_Ptr;
  95.    Buffer_Pos    : INTEGER         (* Current buffer position           *);
  96.    Buffer_Length : WORD            (* Buffer length                     *);
  97.    CRC_Used_2    : BOOLEAN         (* TRUE to use CRC method            *);
  98.    Long_Buffer   : BOOLEAN         (* TRUE if separate buffer used      *);
  99.    Kbd_Ch        : CHAR            (* Character entered from keyboard   *);
  100.    Full_File_Name: AnyStr          (* Full file name of file to receive *);
  101.    Dup_Block     : BOOLEAN         (* TRUE if duplicate block error     *);
  102.    BS_Flag       : BOOLEAN         (* Swallows up duplicate block       *);
  103.    W_Count       : INTEGER         (* Count to write                    *);
  104.  
  105.    Block_Start_Set : SET OF ^A..^Z (* Set of legal block start chars    *);
  106.    SVal            : STRING[10]    (* For debugging conversions         *);
  107.    Flush_Count     : INTEGER       (* Count of blocks to flush if bad   *);
  108.    Save_XonXoff    : BOOLEAN       (* Saves XON/XOFF status             *);
  109.    Err_Mess        : AnyStr        (* Error message                     *);
  110.    G_Failure       : BOOLEAN       (* TRUE if G-type protocol failed    *);
  111.    Save_XonOv      : BOOLEAN       (* Saves Xon/Xoff buffer overflow    *);
  112.    SCps            : STRING[20]    (* String form of CPS transfer rate  *);
  113.  
  114. (*----------------------------------------------------------------------*)
  115. (*           Open_Receiving_File --- open file to receive download      *)
  116. (*----------------------------------------------------------------------*)
  117.  
  118. PROCEDURE Open_Receiving_File;
  119.  
  120. VAR
  121.    Err        : INTEGER;
  122.    B          : BOOLEAN;
  123.    Local_Save : Saved_Screen_Ptr;
  124.  
  125. BEGIN (* Open_Receiving_File *)
  126.                                    (* Check if file name given yet. *)
  127.                                    (* If not, prompt for it.        *)
  128.    IF ( FileName = '' ) THEN
  129.       IF Attended_Mode THEN
  130.          BEGIN
  131.  
  132.             B              := Do_Status_Time;
  133.             Do_Status_Time := FALSE;
  134.  
  135.             Save_Partial_Screen( Local_Save, 1, Max_Screen_Line,
  136.                                  Max_Screen_Col, Max_Screen_Line );
  137.  
  138.             PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
  139.  
  140.             GoToXY( 1 , Max_Screen_Line );
  141.  
  142.             WRITE('Enter file name to receive download: ');
  143.             ClrEol;
  144.  
  145.             CursorOn;
  146.  
  147.             Read_Edited_String( FileName );
  148.  
  149.             CursorOff;
  150.  
  151.             Restore_Screen( Local_Save );
  152.  
  153.             Do_Status_Time := B;
  154.  
  155.          END
  156.       ELSE
  157.                                    (* No file name is death in unattended mode *)
  158.          BEGIN
  159.  
  160.             GoToXY( 25 , 10 );
  161.             WRITE('No file name received from remote system, receive cancelled.');
  162.             ClrEol;
  163.  
  164.             Write_Log('No file name received from remote system, receive cancelled.',
  165.                       TRUE, FALSE);
  166.  
  167.             Window_Delay;
  168.  
  169.             Error_Flag   := TRUE;
  170.             Stop_Receive := TRUE;
  171.  
  172.          END;
  173.                                    (* Append download directory name *)
  174.                                    (* if necessary.                  *)
  175.  
  176.    IF ( FileName <> '' ) THEN
  177.       BEGIN
  178.  
  179.          Add_Path( FileName, Download_Dir_Path, Full_File_Name );
  180.  
  181.                                    (* Open reception file *)
  182.  
  183.          IF ( NOT RFile_Open ) THEN
  184.             BEGIN
  185.  
  186.                ASSIGN ( XFile , Full_File_Name );
  187.                REWRITE( XFile , 1 );
  188.  
  189.                IF ( Int24Result <> 0 ) THEN
  190.                   BEGIN
  191.  
  192.                      GoToXY( 25 , 10 );
  193.                      WRITE('Cannot open file, receive cancelled.');
  194.                      ClrEol;
  195.  
  196.                      Write_Log('Cannot open file, receive cancelled.',
  197.                                TRUE, FALSE);
  198.  
  199.                      Window_Delay;
  200.  
  201.                      Stop_Receive := TRUE;
  202.                      Error_Flag   := TRUE;
  203.  
  204.                   END
  205.                ELSE
  206.                   RFile_Open := TRUE;
  207.  
  208.             END;
  209.  
  210.          IF Rfile_Open THEN
  211.             Write_Log('Receiving file ' + Full_File_Name, TRUE, FALSE );
  212.  
  213.       END;
  214.  
  215. END   (* Open_Receiving_File *);
  216.  
  217. (*----------------------------------------------------------------------*)
  218. (* Update_Xmodem_Receive_Display --- Update display of Xmodem reception *)
  219. (*----------------------------------------------------------------------*)
  220.  
  221. PROCEDURE  Update_Xmodem_Receive_Display;
  222.  
  223. BEGIN (* Update_Xmodem_Receive_Display *)
  224.  
  225.    GoToXY( 25 , 1 );
  226.    WRITE( Sector_Count );
  227.    GoToXY( 35 , 1 );
  228.    WRITE( Sector_Count SHR 3, 'K' );
  229.    GoToXY( 25 , 2 );
  230.    WRITE(BlockL_Errors);
  231.    GoToXY( 25 , 3 );
  232.    WRITE(SOH_Errors);
  233.    GoToXY( 25 , 4 );
  234.    WRITE(BlockN_Errors);
  235.    GoToXY( 25 , 5 );
  236.    WRITE(Comple_Errors);
  237.    GoToXY( 25 , 6 );
  238.    WRITE(TimeOut_Errors);
  239.    GoToXY( 25 , 7 );
  240.    WRITE(Resend_Errors);
  241.    GoToXY( 25 , 8 );
  242.    WRITE(CRC_Errors);
  243.  
  244.    IF Display_Time THEN
  245.       BEGIN
  246.          GoToXY( 25 , 9 );
  247.          WRITE( TimeString( Time_To_Send , Military_Time ) );
  248.       END;
  249.  
  250. END   (* Update_Xmodem_Receive_Display *);
  251.  
  252. (*----------------------------------------------------------------------*)
  253. (*     Display_Receive_Error --- Display XMODEM reception error         *)
  254. (*----------------------------------------------------------------------*)
  255.  
  256. PROCEDURE Display_Receive_Error( Err_Text: AnyStr );
  257.  
  258. VAR
  259.    S: STRING[10];
  260.  
  261. BEGIN (* Display_Receive_Error *)
  262.  
  263.    IF ( NOT Display_Status ) THEN
  264.       Flip_Display_Status;
  265.  
  266.    STR( Sector_Count , S );
  267.    Err_Mess := Err_Text + ' around block ' + S;
  268.  
  269.    GoToXY( 25 , 10 );
  270.    WRITE(Err_Mess);
  271.    ClrEol;
  272.  
  273.    Write_Log( Err_Mess, TRUE, FALSE );
  274.  
  275.    Error_Flag := TRUE;
  276.  
  277. END   (* Display_Receive_Error *);
  278.  
  279. (*----------------------------------------------------------------------*)
  280. (* WXModem_Receive_With_TimeOut --- Get character from port for WXModem *)
  281. (*----------------------------------------------------------------------*)
  282.  
  283. PROCEDURE WXModem_Receive_With_TimeOut( VAR Ch : INTEGER );
  284.  
  285. (* STRUCTURED *) CONST
  286.    Special_Chars : SET OF BYTE = [DLE,SYN,XON,XOFF];
  287.  
  288. BEGIN (* WXModem_Receive_With_TimeOut *)
  289.  
  290.    Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  291.  
  292.    IF Do_WXModem THEN
  293.       IF ( Ch = DLE ) THEN
  294.          BEGIN
  295.             IF ( Ch IN Special_Chars ) THEN
  296.                BEGIN
  297.                   Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  298.                   IF ( Ch <> TimeOut ) THEN
  299.                      Ch := Ch XOR 64;
  300.                END
  301.          END
  302.       ELSE
  303.          IF ( Ch = SYN ) THEN
  304.             Ch := TimeOut;
  305.  
  306. END   (* WXModem_Receive_With_TimeOut *);
  307.  
  308. (*----------------------------------------------------------------------*)
  309. (*           Receive_Xmodem_Sector --- Get sector using XMODEM          *)
  310. (*----------------------------------------------------------------------*)
  311.  
  312. FUNCTION Receive_Xmodem_Sector( CRC_Used : BOOLEAN ) : BOOLEAN;
  313.  
  314. (*----------------------------------------------------------------------*)
  315. (*                                                                      *)
  316. (*     Function:   Receive_Xmodem_Sector                                *)
  317. (*                                                                      *)
  318. (*     Purpose:    Gets one sector using XMODEM protocol.               *)
  319. (*                                                                      *)
  320. (*     Calling Sequence:                                                *)
  321. (*                                                                      *)
  322. (*        OK_Get := Receive_Xmodem_Sector( CRC_Used : BOOLEAN )         *)
  323. (*                                       : BOOLEAN;                     *)
  324. (*                                                                      *)
  325. (*           CRC_Used --- TRUE to use Cyclic redundancy check version   *)
  326. (*                       of XMODEM; FALSE to use Checksum version.      *)
  327. (*           OK_Get  --- TRUE if sector received correctly              *)
  328. (*                                                                      *)
  329. (*     Calls:   Async_Send                                              *)
  330. (*              Async_Receive_With_TimeOut                              *)
  331. (*              Display_Receive_Error                                   *)
  332. (*              Print_Spooled_File                                      *)
  333. (*                                                                      *)
  334. (*----------------------------------------------------------------------*)
  335.  
  336. VAR
  337.    CRC        : INTEGER;
  338.    Checksum   : INTEGER;
  339.    I          : INTEGER;
  340.    Error_Fl   : BYTE;
  341.    Receive_OK : BOOLEAN;
  342.  
  343.    Debug_Sect : ARRAY[1..128] OF CHAR ABSOLUTE Sector_Data;
  344.  
  345. BEGIN (* Receive_Xmodem_Sector *)
  346.  
  347.                                    (* Clear async error flags        *)
  348.  
  349.    Receive_OK := Async_Line_Error( Error_Fl );
  350.  
  351.                                    (* Pick up sector data, calculate *)
  352.                                    (* checksum or CRC                *)
  353.  
  354.    Receive_Xmodem_Sector := FALSE;
  355.    Receive_OK            := FALSE;
  356.  
  357.    Checksum    := 0;
  358.    CRC         := 0;
  359.                                    (* Sector length is 128 for usual *)
  360.                                    (* Xmodem or Telink; is 1024 for  *)
  361.                                    (* Ymodem.                        *)
  362.  
  363.    FOR I := 1 TO Sector_Length DO
  364.       BEGIN
  365.                                    (* Get next char from comm port *)
  366. {
  367.          IF Do_WXModem THEN
  368.             WXModem_Receive_With_TimeOut( Ch )
  369.          ELSE
  370.             Xmodem_Receive_With_TimeOut( Ch );
  371. }
  372.          Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  373.  
  374.                                    (* Check for timeout  *)
  375.          IF ( Ch = TimeOut ) THEN
  376.             BEGIN
  377.                Display_Receive_Error('Block length error');
  378.                INC( BlockL_Errors );
  379.                EXIT;
  380.             END;
  381.                                    (* Store received character *)
  382.          Sector_Data[I] := Ch;
  383.                                    (* Update CRC or Checksum   *)
  384.          IF CRC_Used THEN
  385.             BEGIN
  386.                CRC := SWAP( CRC ) XOR ORD( Ch );
  387.                CRC := CRC XOR ( LO( CRC ) SHR 4 );
  388.                CRC := CRC XOR ( SWAP( LO( CRC ) ) SHL 4 )
  389.                           XOR ( LO( CRC ) SHL 5 );
  390.             END
  391.          ELSE
  392.             Checksum := ( Checksum + Ch ) AND 255;
  393.  
  394.       END;
  395.                                    (* Now get trailing CRC or  *)
  396.                                    (* checksum value.          *)
  397.    IF CRC_Used THEN
  398.       BEGIN   (* Receive CRC *)
  399.                                    (* Get first byte of CRC    *)
  400. {
  401.          IF Do_WXModem THEN
  402.             WXModem_Receive_With_TimeOut( Ch )
  403.          ELSE
  404.             Xmodem_Receive_With_TimeOut( Ch );
  405. }
  406.          Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  407.  
  408.                                    (* Check for timeout        *)
  409.          IF ( Ch <> TimeOut ) THEN
  410.             BEGIN  (* Byte CRC OK *)
  411.  
  412.                                    (* Update CRC               *)
  413.  
  414.                CRC := SWAP( CRC ) XOR ORD( Ch );
  415.                CRC := CRC XOR ( LO( CRC ) SHR 4 );
  416.                CRC := CRC XOR ( SWAP( LO( CRC ) ) SHL 4 )
  417.                           XOR ( LO( CRC ) SHL 5 );
  418.  
  419.                                    (* Get second byte of CRC   *)
  420. {
  421.                IF Do_WXModem THEN
  422.                   WXModem_Receive_With_TimeOut( Ch )
  423.                ELSE
  424.                   Xmodem_Receive_With_TimeOut( Ch );
  425. }
  426.                Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  427.  
  428.                                    (* If not timeout, update CRC *)
  429.                                    (* and check if it is zero.   *)
  430.                                    (* Zero CRC means OK sector.  *)
  431.  
  432.                IF ( Ch <> TimeOut ) THEN
  433.                   BEGIN  (* Byte 2 CRC OK *)
  434.  
  435.                      CRC := SWAP( CRC ) XOR ORD( Ch );
  436.                      CRC := CRC XOR ( LO( CRC ) SHR 4 );
  437.                      CRC := CRC XOR ( SWAP( LO( CRC ) ) SHL 4 )
  438.                                 XOR ( LO( CRC ) SHL 5 );
  439.  
  440.                      Receive_OK := ( CRC = 0 );
  441.  
  442.                   END    (* Byte 2 CRC OK *)
  443.                ELSE
  444.                   BEGIN  (* Byte 2 CRC TimeOut *)
  445.  
  446.                      Display_Receive_Error('Block length error');
  447.                      INC( BlockL_Errors );
  448.  
  449.                   END    (* Byte 2 CRC TimeOut *)
  450.  
  451.             END   (* Byte 1 CRC OK *)
  452.  
  453.          ELSE
  454.             BEGIN (* Byte 1 CRC TimeOut *)
  455.  
  456.                Display_Receive_Error('Block length error');
  457.                INC( BlockL_Errors );
  458.  
  459.             END   (* Byte 1 CRC TimeOut *);
  460.  
  461.       END     (* Compute CRC *)
  462.  
  463.    ELSE
  464.       BEGIN   (* Receive Checksum *)
  465.  
  466.                                    (* Read sector checksum, see if it matches *)
  467.                                    (* what we computed from sector read.      *)
  468. {
  469.          IF Do_WXModem THEN
  470.             WXModem_Receive_With_TimeOut( Ch )
  471.          ELSE
  472.             Xmodem_Receive_With_TimeOut( Ch );
  473. }
  474.          Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  475.  
  476.          Receive_OK := ( Checksum = Ch );
  477.  
  478.       END    (* Receive Checksum *);
  479.  
  480.    Receive_Xmodem_Sector := Receive_OK AND
  481.                             ( NOT Async_Line_Error( Error_Fl ) );
  482.  
  483.                                    (* Print character from spooled file *)
  484.    IF Print_Spooling THEN
  485.       Print_Spooled_File;
  486.  
  487. END   (* Receive_Xmodem_Sector *);
  488.  
  489. (*----------------------------------------------------------------------*)
  490. (*           Receive_Telink_Header --- Get Telink block 0 header        *)
  491. (*----------------------------------------------------------------------*)
  492.  
  493. PROCEDURE Receive_Telink_Header;
  494.  
  495. (*----------------------------------------------------------------------*)
  496. (*                                                                      *)
  497. (*     Procedure:  Receive_Telink_Header                                *)
  498. (*                                                                      *)
  499. (*     Purpose:    Gets Telink header block 0 (filename+size+date)      *)
  500. (*                                                                      *)
  501. (*     Calling Sequence:                                                *)
  502. (*                                                                      *)
  503. (*        Receive_Telink_Header;                                        *)
  504. (*                                                                      *)
  505. (*     Calls:                                                           *)
  506. (*                                                                      *)
  507. (*        Trim                                                          *)
  508. (*        Dir_Convert_Time                                              *)
  509. (*        Dir_Convert_Date                                              *)
  510. (*        Draw_Menu_Frame                                               *)
  511. (*                                                                      *)
  512. (*----------------------------------------------------------------------*)
  513.  
  514. VAR
  515.    I      : INTEGER;
  516.    CDate  : STRING[8];
  517.    CTime  : STRING[8];
  518.    Date   : LONGINT;
  519.    DTRec  : DateTime;
  520.  
  521.    Debug_Sector_Data : PACKED ARRAY[1..44] OF CHAR ABSOLUTE Sector_Data;
  522.  
  523. BEGIN  (* Receive_Telink_Header *)
  524.  
  525.    RFile_Size := 0;
  526.    RFile_Name := '';
  527.                                    (* Get file size *)
  528.    FOR I := 4 DOWNTO 1 DO
  529.       RFile_Size := RFile_Size * 256 + Sector_Data[I];
  530.  
  531.    Blocks_To_Send := ROUND( RFile_Size / 128.0 + 0.49 );
  532.  
  533.                                    (* Get time/date *)
  534.  
  535.    IF ( Transfer_Protocol = Telink ) THEN
  536.       BEGIN
  537.          File_Time := Sector_Data[6] SHL 8 OR Sector_Data[5];
  538.          File_Date := Sector_Data[8] SHL 8 OR Sector_Data[7];
  539.       END
  540.    ELSE
  541.       BEGIN
  542.  
  543.          Date := ORD( Sector_Data[8] ) SHL 8 + ORD( Sector_Data[7] );
  544.          Date := 65536 * Date + ORD( Sector_Data[6] ) SHL 8 + ORD( Sector_Data[5] );
  545.  
  546.          IF ( Date > 0 ) THEN
  547.             WITH DTRec DO
  548.                BEGIN
  549.  
  550.                   Get_Unix_Style_Date( Date, Year, Month, Day, Hour, Min, Sec );
  551.  
  552.                   File_Time := Hour SHL 11 OR Min SHL 5 OR ( Sec DIV 2 );
  553.                   File_Date := MAX( Year - 1980 , 0 ) SHL 9 + Month SHL 5 + Day;
  554.  
  555.                END;
  556.  
  557.       END;
  558.                                    (* Get file name *)
  559.    FOR I := 9 TO 24 DO
  560.       IF Sector_Data[I] <> 0 THEN
  561.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  562.  
  563.    RFile_Name := TRIM( RFile_Name );
  564.  
  565.    IF ( FileName = '' ) THEN
  566.       IF ( RFile_Name <> '' ) THEN
  567.          FileName := RFile_Name;
  568.  
  569.    Draw_Menu_Frame( 10, 10, 78, 23, Menu_Frame_Color, Menu_Title_Color,
  570.                     Menu_Text_Color,
  571.                     'Receive file ' + FileName );
  572.  
  573.    IF ( ( File_Date <> 0 ) AND ( File_Time <> 0 ) ) THEN
  574.       BEGIN
  575.          Dir_Convert_Time( File_Time, CTime );
  576.          Dir_Convert_Date( File_Date, CDate );
  577.       END
  578.    ELSE
  579.       BEGIN
  580.          CTime := '';
  581.          CDate := '';
  582.       END;
  583.  
  584.    Draw_Menu_Frame( 10, 3, 78, 9, Menu_Frame_Color, Menu_Title_Color,
  585.                     Menu_Text_Color, '' );
  586.  
  587.                                    (* Headings for Telink information *)
  588.    PibTerm_Window( 11, 4, 77, 8 );
  589.  
  590.    GoToXY( 1 , 1 );
  591.    TextColor( Menu_Text_Color_2 );
  592.    WRITE(' File name            : ');
  593.    TextColor( Menu_Text_Color );
  594.    WRITE(FileName);
  595.    GoToXY( 1 , 2 );
  596.    TextColor( Menu_Text_Color_2 );
  597.    WRITE(' File Size in bytes   : ');
  598.    TextColor( Menu_Text_Color );
  599.    WRITE(RFile_Size:8);
  600.    GoToXY( 1 , 3 );
  601.    TextColor( Menu_Text_Color_2 );
  602.    WRITE(' File Size in blocks  : ');
  603.    TextColor( Menu_Text_Color );
  604.    WRITE(Blocks_To_Send:8);
  605.    GoToXY( 1 , 4 );
  606.    TextColor( Menu_Text_Color_2 );
  607.    WRITE(' File creation time   : ');
  608.    TextColor( Menu_Text_Color );
  609.    WRITE( CTime );
  610.    GoToXY( 1 , 5 );
  611.    TextColor( Menu_Text_Color_2 );
  612.    WRITE(' File creation date   : ');
  613.    TextColor( Menu_Text_Color );
  614.    WRITE( CDate );
  615.                                    (* Restore previous window *)
  616.    PibTerm_Window( 11, 11, 77, 21 );
  617.  
  618.    IF RFile_Size > 0 THEN
  619.       BEGIN
  620.  
  621.          Display_Time       := TRUE;
  622.          Time_To_Send       := ROUND( Blocks_To_Send * ( Trans_Time_Val / Baud_Rate ) );
  623.          Saved_Time_To_Send := Time_To_Send;
  624.  
  625.          IF Display_Status THEN
  626.             Initialize_Receive_Display;
  627.  
  628.          Truncate_File  := TRUE;
  629.  
  630.       END;
  631. {
  632.                                    (* Handle SEALink file name *)
  633.    IF Do_SeaLink THEN
  634.       BEGIN
  635.                                    (* Prevent clobbers in host mode *)
  636.          IF Host_Mode THEN
  637.             IF ( Privilege <> 'S' ) THEN
  638.                Stop_Receive := Stop_Receive OR
  639.                                Check_If_File_Exists( FileName , Download_Dir_Path );
  640.  
  641.                                   (* If null file name, this means *)
  642.                                   (* end of SEALink batch, so quit. *)
  643.  
  644.          IF LENGTH( RFile_Name ) = 0 THEN
  645.             BEGIN
  646.                Null_File_Name := TRUE;
  647.                EXIT;
  648.             END;
  649.                                    (* Open reception file     *)
  650.  
  651.          IF ( NOT Stop_Receive ) THEN
  652.             Open_Receiving_File;
  653.  
  654.       END;
  655. }
  656. END    (* Receive_Telink_Header *);
  657.  
  658. (*----------------------------------------------------------------------*)
  659. (*           Receive_Ymodem_Header --- Get Ymodem block 0 header        *)
  660. (*----------------------------------------------------------------------*)
  661.  
  662. PROCEDURE Receive_Ymodem_Header;
  663.  
  664. (*----------------------------------------------------------------------*)
  665. (*                                                                      *)
  666. (*     Procedure:  Receive_Ymodem_Header                                *)
  667. (*                                                                      *)
  668. (*     Purpose:    Gets Ymodem header block 0 (filename+size+date)      *)
  669. (*                                                                      *)
  670. (*     Calling Sequence:                                                *)
  671. (*                                                                      *)
  672. (*        Receive_Ymodem_Header                                         *)
  673. (*                                                                      *)
  674. (*     Calls:                                                           *)
  675. (*                                                                      *)
  676. (*        Draw_Menu_Frame                                               *)
  677. (*        Dir_Convert_Time                                              *)
  678. (*        Dir_Convert_Date                                              *)
  679. (*        Open_Receiving_File                                           *)
  680. (*                                                                      *)
  681. (*----------------------------------------------------------------------*)
  682.  
  683. VAR
  684.    I     : INTEGER;
  685.    L     : INTEGER;
  686.    CTime : STRING[10];
  687.    CDate : STRING[10];
  688.    DTRec : DateTime;
  689.  
  690. BEGIN  (* Receive_Ymodem_Header *)
  691.  
  692.    RFile_Size := 0;
  693.    RFile_Date := 0;
  694.    RFile_Name := '';
  695.    File_Time  := 0;
  696.    File_Date  := 0;
  697.                                    (* Pick up file name *)
  698.    I := 1;
  699.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  700.       BEGIN
  701.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  702.          INC( I );
  703.       END;
  704.                                   (* If null file name, this means *)
  705.                                   (* end of Ymodem batch, so quit. *)
  706.    IF LENGTH( RFile_Name ) = 0 THEN
  707.       BEGIN
  708.          Null_File_Name := TRUE;
  709.          EXIT;
  710.       END;
  711.                                   (* Pick up file size *)
  712.    INC( I );
  713.  
  714.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  715.       BEGIN
  716.          RFile_Size := RFile_Size * 10 + ORD( Sector_Data[I] ) - ORD('0');
  717.          INC( I );
  718.       END;
  719.  
  720.    INC( I );
  721.  
  722.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  723.       BEGIN
  724.          RFile_Date := RFile_Date * 8 + ORD( Sector_Data[I] ) - ORD('0');
  725.          INC( I );
  726.       END;
  727.  
  728.    IF RFile_Date > 0 THEN
  729.       WITH DTRec DO
  730.          BEGIN
  731.  
  732.             Get_Unix_Style_Date( RFile_Date, Year, Month, Day, Hour, Min, Sec );
  733.  
  734.             File_Time := Hour SHL 11 OR Min SHL 5 OR ( Sec DIV 2 );
  735.             File_Date := MAX( Year - 1980 , 0 ) SHL 9 + Month SHL 5 + Day;
  736.  
  737.             Dir_Convert_Time( File_Time, CTime );
  738.             Dir_Convert_Date( File_Date, CDate );
  739.  
  740.       END;
  741.  
  742.    Draw_Menu_Frame( 10, 3, 78, 9, Menu_Frame_Color, Menu_Title_Color,
  743.                     Menu_Text_Color,
  744.                     'Receive file ' + RFile_Name );
  745.  
  746.                                    (* Headings for Ymodem information *)
  747.    PibTerm_Window( 11, 4, 77, 8 );
  748.  
  749.    GoToXY( 1 , 1 );
  750.    TextColor( Menu_Text_Color_2 );
  751.    WRITE(' File name            : ');
  752.    TextColor( Menu_Text_Color );
  753.    WRITE(RFile_Name);
  754.  
  755.    Blocks_To_Send := ROUND( RFile_Size / 128.0 + 0.49 );
  756.  
  757.    IF RFile_Size > 0 THEN
  758.       BEGIN
  759.          GoToXY( 1 , 2 );
  760.          TextColor( Menu_Text_Color_2 );
  761.          WRITE(' File Size in bytes   : ');
  762.          TextColor( Menu_Text_Color );
  763.          WRITE(RFile_Size:8);
  764.          GoToXY( 1 , 3 );
  765.          TextColor( Menu_Text_Color_2 );
  766.          WRITE(' File Size in blocks  : ');
  767.          TextColor( Menu_Text_Color );
  768.          WRITE(Blocks_To_Send:8);
  769.       END;
  770.  
  771.    IF File_Date > 0 THEN
  772.       BEGIN
  773.          GoToXY( 1 , 4 );
  774.          TextColor( Menu_Text_Color_2 );
  775.          WRITE(' File creation time   : ');
  776.          TextColor( Menu_Text_Color );
  777.          WRITE( CTime );
  778.          GoToXY( 1 , 5 );
  779.          TextColor( Menu_Text_Color_2 );
  780.          WRITE(' File creation date   : ');
  781.          TextColor( Menu_Text_Color );
  782.          WRITE( CDate );
  783.       END;
  784.                                    (* If path name sent along with *)
  785.                                    (* file name, strip it unless   *)
  786.                                    (* "Use_Full_Path_Name" option  *)
  787.                                    (* is active.                   *)
  788.    FileName := RFile_Name;
  789.  
  790.    IF ( ( POS( '\' , FileName ) <> 0 ) OR
  791.         ( POS( ':' , FileName ) <> 0 ) ) THEN
  792.       IF ( NOT Use_Full_Path_Name ) THEN
  793.          BEGIN
  794.             L := LENGTH( FileName );
  795.             I := L;
  796.             REPEAT
  797.                DEC( I );
  798.             UNTIL ( ( I = 1 )             OR
  799.                     ( FileName[I] = '\' ) OR
  800.                     ( FileName[I] = ':' )     );
  801.             FileName := COPY( FileName, SUCC( I ), L - I );
  802.          END;
  803.                                    (* Restore previous window *)
  804.    PibTerm_Window( 11, 11, 77, 21 );
  805.  
  806.    IF Rfile_Size > 0 THEN
  807.       BEGIN
  808.  
  809.          Display_Time       := TRUE;
  810.          Time_To_Send       := ROUND( Blocks_To_Send * ( Trans_Time_Val / Baud_Rate ) );
  811.          Saved_Time_To_Send := Time_To_Send;
  812.  
  813.          IF Display_Status THEN
  814.             Initialize_Receive_Display;
  815.  
  816.          Truncate_File  := ( RFile_Size > 0 );
  817.  
  818.       END;
  819.                                    (* Prevent clobbers in host mode *)
  820.    IF Host_Mode THEN
  821.       IF ( Privilege <> 'S' ) THEN
  822.          Stop_Receive := Stop_Receive OR
  823.                          Check_If_File_Exists( FileName , Download_Dir_Path );
  824.  
  825.                                    (* Open reception file     *)
  826.    IF ( NOT Stop_Receive ) THEN
  827.       Open_Receiving_File;
  828.                                    (* Post name in display window *)
  829.  
  830.    IF ( RFile_Name = '' ) THEN
  831.       BEGIN
  832.          PibTerm_Window( 11, 4, 77, 8 );
  833.          GoToXY( 1 , 1 );
  834.          TextColor( Menu_Text_Color_2 );
  835.          WRITE(' File name            : ');
  836.          TextColor( Menu_Text_Color );
  837.          WRITE(FileName);
  838.          PibTerm_Window( 11, 11, 77, 21 );
  839.       END;
  840.                                    (* Reset CRC counter       *)
  841.    CRC_Tries := 0;
  842.    CRC_Used  := TRUE;
  843.  
  844. END    (* Receive_Ymodem_Header *);
  845.  
  846. (*----------------------------------------------------------------------*)
  847. (*        Wait_For_SOH --- Wait for start for start of XMODEM block     *)
  848. (*----------------------------------------------------------------------*)
  849.  
  850. PROCEDURE Wait_For_SOH(     Wait_Time    : INTEGER;
  851.                         VAR Initial_Ch   : INTEGER;
  852.                         VAR Stop_Receive : BOOLEAN  );
  853.  
  854. (*----------------------------------------------------------------------*)
  855. (*                                                                      *)
  856. (*     Procedure:  Wait_For_SOH                                         *)
  857. (*                                                                      *)
  858. (*     Purpose:    Waits for SOH/STX/SYN initiating Xmodem block        *)
  859. (*                                                                      *)
  860. (*     Calling Sequence:                                                *)
  861. (*                                                                      *)
  862. (*        Wait_For_SOH(     Wait_Time    : INTEGER;                     *)
  863. (*                      VAR Initial_Ch   : INTEGER;                     *)
  864. (*                      VAR Stop_Receive : BOOLEAN );                   *)
  865. (*                                                                      *)
  866. (*           Wait_Time    --- time to wait for character in seconds     *)
  867. (*           Initial_Ch   --- returned initial character                *)
  868. (*           Stop_Receive --- TRUE if Alt-R hit to stop transfer        *)
  869. (*                                                                      *)
  870. (*     Calls:                                                           *)
  871. (*                                                                      *)
  872. (*        Async_Receive_With_TimeOut                                    *)
  873. (*                                                                      *)
  874. (*----------------------------------------------------------------------*)
  875.  
  876. VAR
  877.    ITime          : INTEGER;
  878.    SOH_Start_Time : LONGINT;
  879.    SOH_Char       : CHAR;
  880.  
  881. BEGIN  (* Wait_For_SOH *)
  882.                                    (* If already cancelled transfer, *)
  883.                                    (* don't look for more input!     *)
  884.    Initial_Ch := TimeOut;
  885.  
  886.    IF Stop_Receive THEN EXIT;
  887.                                    (* Look for start of Xmodem block *)
  888.    ITime := 0;
  889.  
  890.    REPEAT
  891.  
  892.       INC( ITime );
  893.       Initial_Ch     := TimeOut;
  894.       SOH_Start_Time := TimeOfDayH;
  895.  
  896.       REPEAT
  897.          IF Async_Receive( SOH_Char ) THEN
  898.             BEGIN
  899.                IF ( SOH_Char IN Block_Start_Set ) THEN
  900.                   Initial_Ch := ORD( SOH_Char );
  901.             END;
  902.       UNTIL ( Initial_Ch <> TimeOut ) OR
  903.             ( TimeDiffH( SOH_Start_Time , TimeOfDayH ) > 100 );
  904.  
  905.                                    (* Check for keyboard input -- Alt_R *)
  906.                                    (* cancels transfer.                 *)
  907.       Check_KeyBoard;
  908.                                    (* Also stop transfer if carrier drops *)
  909.       IF Async_Carrier_Drop THEN
  910.          BEGIN
  911.             Stop_Receive := TRUE;
  912.             Initial_Ch   := TimeOut;
  913.          END;
  914.                                    (* Print character from spooled file *)
  915.       IF Print_Spooling THEN
  916.          Print_Spooled_File;
  917.  
  918.    UNTIL ( Stop_Receive          OR
  919.            ( ITime > Wait_Time ) OR
  920.            ( Initial_Ch <> TimeOut ) );
  921.  
  922. END    (* Wait_For_SOH *);
  923.  
  924. (*----------------------------------------------------------------------*)
  925. (*       Set_File_Date_And_Time --- set file date and time stamp        *)
  926. (*----------------------------------------------------------------------*)
  927.  
  928. PROCEDURE Set_File_Date_And_Time;
  929.  
  930. VAR
  931.    Time : LONGINT;
  932.    T    : ARRAY[1..2] OF WORD ABSOLUTE Time;
  933.  
  934. BEGIN (* Set_File_Date_And_Time *)
  935.  
  936.    T[1] := File_Time;
  937.    T[2] := File_Date;
  938.  
  939.    SetFTime( XFile , Time );
  940.  
  941.    IF ( DosError <> 0 ) THEN
  942.       BEGIN
  943.  
  944.          IF ( NOT Display_Status ) THEN
  945.             Flip_Display_Status;
  946.  
  947.          GoToXY( 25 , 10 );
  948.          WRITE('Could not set date/time for file.');
  949.          ClrEol;
  950.  
  951.          Window_Delay;
  952.  
  953.          Write_Log('Cannot set date/time', TRUE, FALSE );
  954.  
  955.       END;
  956.  
  957. END   (* Set_File_Date_And_Time *);
  958.  
  959. (*----------------------------------------------------------------------*)
  960. (*             Write_File_Data --- Write received data to file          *)
  961. (*----------------------------------------------------------------------*)
  962.  
  963. PROCEDURE Write_File_Data;
  964.  
  965. PROCEDURE Do_Actual_Write( Write_Count: INTEGER );
  966.  
  967. BEGIN (* Do_Actual_Write *)
  968.                                    (* Truncate file as necessary *)
  969.  
  970.    IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND Truncate_File THEN
  971.       Write_Count := TRUNC( RFile_Size - Rfile_Size_2 );
  972.  
  973.    W_Count := Write_Count;
  974.                                    (* Stop data reception for WXModem *)
  975.    IF Do_WXModem THEN
  976.       BEGIN
  977.          Async_Send( CHR( XOFF ) );
  978.          DELAY( XOFF_Delay );
  979.       END;
  980.  
  981.    BlockWrite( XFile, Write_Buffer^, W_Count, Write_Count );
  982.  
  983.    IF Do_WXModem THEN
  984.       Async_Send( CHR( XON ) );
  985.  
  986.    IF ( Int24Result <> 0 ) OR ( Write_Count <> W_Count ) THEN
  987.       BEGIN
  988.  
  989.          IF ( NOT Display_Status ) THEN
  990.             Flip_Display_Status;
  991.  
  992.          GoToXY( 25 , 10 );
  993.          WRITE('Error writing to disk, transfer cancelled.');
  994.          Write_Log('Error writing to disk.' , TRUE, FALSE );
  995.          ClrEol;
  996.          Window_Delay;
  997.  
  998.          Error_Flag   := TRUE;
  999.          Stop_Receive := TRUE;
  1000.  
  1001.       END;
  1002.  
  1003.    RFile_Size_2 := RFile_Size_2 + Write_Count;
  1004.  
  1005. END   (* Do_Actual_Write *);
  1006.  
  1007. (*----------------------------------------------------------------------*)
  1008.  
  1009. BEGIN (* Write_File_Data *)
  1010.                                    (* Make sure file is open *)
  1011.    IF ( NOT RFile_Open ) THEN
  1012.       BEGIN
  1013.          Open_Receiving_File;
  1014.          IF Stop_Receive THEN EXIT;
  1015.       END;
  1016.                                    (* Write directly from sector *)
  1017.                                    (* if not long buffer used    *)
  1018.    IF ( NOT Long_Buffer ) THEN
  1019.       Do_Actual_Write( Sector_Length )
  1020.  
  1021.                                    (* Store sector data in long  *)
  1022.                                    (* buffer and write file if   *)
  1023.                                    (* necessary.                 *)
  1024.  
  1025.    ELSE
  1026.       BEGIN
  1027.  
  1028.          IF ( Buffer_Pos + Sector_Length ) > Buffer_Length THEN
  1029.             BEGIN
  1030.                Do_Actual_Write( Buffer_Pos );
  1031.                Buffer_Pos   := 0;
  1032.             END;
  1033.  
  1034.          MOVE( Sector_Data, Write_Buffer^[ Buffer_Pos + 1 ], Sector_Length );
  1035.  
  1036.          Buffer_Pos := Buffer_Pos + Sector_Length;
  1037.  
  1038.       END;
  1039.  
  1040. END   (* Write_File_Data *);
  1041.  
  1042.