(*----------------------------------------------------------------------*) (* Receive_Xmodem_File --- Download file using XMODEM *) (*----------------------------------------------------------------------*) PROCEDURE Receive_Xmodem_File( Use_CRC : BOOLEAN ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Receive_Xmodem_File *) (* *) (* Purpose: Downloads file from remote host using XMODEM *) (* protocol. *) (* *) (* Calling Sequence: *) (* *) (* Receive_Xmodem_File( Use_CRC ); *) (* *) (* Use_CRC --- TRUE to use Cyclic redundancy check version *) (* of XMODEM; FALSE to use Checksum version. *) (* *) (* Remarks: *) (* *) (* The transmission parameters are automatically set to: *) (* *) (* Current baud rate, 8 bits, No parity, 1 stop *) (* *) (* and then they are automatically restored to the previous *) (* values when the transfer is complete. *) (* *) (* This code actually controls file reception using any of the *) (* Xmodem-based protocols: Xmodem, Modem7, Telink, and Ymodem. *) (* *) (* Calls: KeyPressed *) (* Async_Send *) (* Async_Receive *) (* Async_Receive_With_Timeout *) (* Async_Purge_Buffer *) (* Compute_Crc *) (* Update_Xmodem_Receive_Display *) (* Display_Receive_Error *) (* Receive_Xmodem_Sector *) (* Receive_Telink_Header *) (* Receive_Ymodem_Header *) (* Wait_For_SOH *) (* Set_File_Date_And_Time *) (* Draw_Menu_Frame *) (* Open_Receiving_File *) (* Write_File_Handle *) (* Close_File_Handle *) (* *) (*----------------------------------------------------------------------*) CONST Max_Errors = 20 (* Maximum errors before aborting *) (* reception *); VAR Sector_Count : INTEGER (* Sector count -- no wrap at 255 *); Sector_Comp : BYTE (* Complement of current sector # *); Sector_Prev : BYTE (* Previous sector number *); I : INTEGER (* Loop index *); Error_Count : INTEGER (* # of errors encountered *); Ch : INTEGER (* Character read from COM port *); Error_Flag : BOOLEAN (* IF an error is found *); Initial_Ch : INTEGER (* Initial character *); Sector_Length : INTEGER (* Sector Length *); Sector_Prev1 : BYTE (* Previous sector + 1 *); BlockL_Errors : INTEGER (* Counts block length errors *); SOH_Errors : INTEGER (* Counts SOH errors *); BlockN_Errors : INTEGER (* Counts block number errors *); Comple_Errors : INTEGER (* Counts complement errors *); Timeout_Errors: INTEGER (* Counts timeout errors *); Resend_Errors : INTEGER (* Counts resend block errors *); CRC_Errors : INTEGER (* Counts checksum/crc errors *); Effective_Rate: REAL (* Effective baud rate of transfer *); CRC_Tries : INTEGER (* Initial CRC tries *); SOH_Time : INTEGER (* Seconds to wait for SOH *); RFile_Size : REAL (* Actual file size *); RFile_Date : REAL (* File date/time *); File_Date : INTEGER (* MS DOS encoded file date *); File_Time : INTEGER (* MS DOS encoded file time *); RFile_Name : AnyStr (* Received file name, Ymodem *); Truncate_File : BOOLEAN (* TRUE to trunc. file to exact size *); RFile_Open : BOOLEAN (* TRUE if receiving file opened *); XFile_Byte : FILE OF BYTE (* For truncating received file *); OK_Transfer : BOOLEAN (* If transfer OK *); Block_Zero : BOOLEAN (* If block 0 encountered *); RFile_Size_2 : REAL (* File size from totalling sectors *); TName : ShortStr (* Transfer type *); Display_Time : BOOLEAN (* Display time remaining for trans. *); Time_To_Send : REAL (* Time in seconds to transfer file *); Start_Time : REAL (* Starting time of transfer *); End_Time : REAL (* Ending time of transfer *); Time_Per_Block: REAL (* Time for one block *); Blocks_To_Get : REAL (* Number of blocks *); Write_Count : INTEGER (* Number of bytes to write *); Err : INTEGER (* Error flag for handle I/O *); (* Write buffer pointer *) Write_Buffer : File_Handle_Buffer_Ptr; Buffer_Pos : INTEGER (* Current buffer position *); Buffer_Length : INTEGER (* Buffer length *); Use_CRC_2 : BOOLEAN (* TRUE to use CRC method *); Menu_Title : AnyStr (* Menu title *); Alt_R_Pressed : BOOLEAN (* TRUE if Alt-R cancelled download *); Long_Buffer : BOOLEAN (* TRUE if separate buffer used *); (*----------------------------------------------------------------------*) (* Open_Receiving_File --- open file to receive download *) (*----------------------------------------------------------------------*) PROCEDURE Open_Receiving_File; VAR Err: INTEGER; BEGIN (* Open_Receiving_File *) (* Check if file name given yet. *) (* If not, prompt for it. *) IF FileName = '' THEN BEGIN Window( 1, 1, 80, 25 ); GoToXY( 1 , 25 ); WRITE('Enter file name to receive download: '); READLN( FileName ); END; (* Open reception file *) IF ( NOT RFile_Open ) THEN BEGIN Err := Create_File_Handle( FileName, Attribute_None, XFile_Handle ); IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN BEGIN GoToXY( 25 , 10 ); WRITE('Cannot open reception file, download cancelled.'); ClrEol; DELAY( One_Second_Delay ); Stop_Receive := TRUE; END ELSE RFile_Open := TRUE; END; IF Rfile_Open THEN Writelne('Receiving file ' + FileName, FALSE ); END (* Open_Receiving_File *); (*----------------------------------------------------------------------*) (* Initialize_Receive_Display --- Set up display of Xmodem reception *) (*----------------------------------------------------------------------*) PROCEDURE Initialize_Receive_Display; BEGIN (* Initialize_Receive_Display *) GoToXY( 1 , 1 ); WRITE(' Blocks received :'); ClrEol; GoToXY( 1 , 2 ); WRITE(' Block length errors :'); ClrEol; GoToXY( 1 , 3 ); WRITE(' SOH errors :'); ClrEol; GoToXY( 1 , 4 ); WRITE(' Block number errors :'); ClrEol; GoToXY( 1 , 5 ); WRITE(' Complement errors :'); ClrEol; GoToXY( 1 , 6 ); WRITE(' Timeout errors :'); ClrEol; GoToXY( 1 , 7 ); WRITE(' Resend block errors :'); ClrEol; GoToXY( 1 , 8 ); IF ( NOT Use_Crc ) THEN WRITE(' Checksum errors :') ELSE WRITE(' CRC errors :'); ClrEol; GoToXY( 1 , 9 ); IF Display_Time THEN WRITE(' Approx. time left :') ELSE WRITE(' '); ClrEol; GoToXY( 1 , 10 ); WRITE (' Last status message :'); ClrEol; END (* Initialize_Receive_Display *); (*----------------------------------------------------------------------*) (* Update_Xmodem_Receive_Display --- Update display of Xmodem reception *) (*----------------------------------------------------------------------*) PROCEDURE Update_Xmodem_Receive_Display; BEGIN (* Update_Xmodem_Receive_Display *) GoToXY( 25 , 1 ); WRITE( Sector_Count ); GoToXY( 25 , 2 ); WRITE(BlockL_Errors); GoToXY( 25 , 3 ); WRITE(SOH_Errors); GoToXY( 25 , 4 ); WRITE(BlockN_Errors); GoToXY( 25 , 5 ); WRITE(Comple_Errors); GoToXY( 25 , 6 ); WRITE(Timeout_Errors); GoToXY( 25 , 7 ); WRITE(Resend_Errors); GoToXY( 25 , 8 ); WRITE(CRC_Errors); IF Display_Time THEN BEGIN GoToXY( 25 , 9 ); WRITE( TimeString( Time_To_Send ) ); END; END (* Update_Xmodem_Receive_Display *); (*----------------------------------------------------------------------*) (* Display_Receive_Error --- Display XMODEM reception error *) (*----------------------------------------------------------------------*) PROCEDURE Display_Receive_Error( Err_Text: AnyStr ); BEGIN (* Display_Receive_Error *) GoToXY( 25 , 10 ); WRITE(Err_Text,' in block ',Sector_Count); ClrEol; Error_Flag := TRUE; END (* Display_Receive_Error *); (*----------------------------------------------------------------------*) (* Receive_Xmodem_Sector --- Get sector using XMODEM *) (*----------------------------------------------------------------------*) FUNCTION Receive_Xmodem_Sector( Use_CRC : BOOLEAN ) : BOOLEAN; (*----------------------------------------------------------------------*) (* *) (* Function: Receive_Xmodem_Sector *) (* *) (* Purpose: Gets one sector using XMODEM protocol. *) (* *) (* Calling Sequence: *) (* *) (* OK_Get := Receive_Xmodem_Sector( Use_CRC : BOOLEAN ) *) (* : BOOLEAN; *) (* *) (* Use_CRC --- TRUE to use Cyclic redundancy check version *) (* of XMODEM; FALSE to use Checksum version. *) (* OK_Get --- TRUE if sector received correctly *) (* *) (* Calls: Async_Send *) (* Async_Receive_With_Timeout *) (* Update_Crc *) (* Display_Receive_Error *) (* *) (*----------------------------------------------------------------------*) VAR CRC : INTEGER; Checksum : INTEGER; I : INTEGER; BEGIN (* Receive_Xmodem_Sector *) (* Pick up sector data, calculate *) (* checksum or CRC *) Receive_Xmodem_Sector := FALSE; Checksum := 0; CRC := 0; (* Sector length is 128 for usual *) (* Xmodem or Telink; is 1024 for *) (* Ymodem. *) FOR I := 1 TO Sector_Length DO BEGIN (* Get next character *) Async_Receive_With_Timeout( One_Second , Ch ); (* Check for timeout *) IF Ch = TimeOut THEN BEGIN Display_Receive_Error('Block length error'); BlockL_Errors := BlockL_Errors + 1; END; (* Store received character *) Sector_Data[I] := Ch; (* Update CRC or Checksum *) IF Use_Crc THEN CRC := Update_CRC( CRC, Ch ) ELSE Checksum := ( Checksum + Ch ) AND 255; END; (* Now get trailing CRC or *) (* checksum value. *) IF Use_Crc THEN BEGIN (* Receive CRC *) (* Get first byte of CRC *) Async_Receive_With_Timeout( One_Second , Ch ); (* Check for timeout *) IF Ch <> Timeout THEN BEGIN (* Byte CRC OK *) (* Update CRC *) CRC := Update_CRC( CRC , Ch ); (* Get second byte of CRC *) Async_Receive_With_Timeout( One_Second , Ch ); (* If not timeout, update CRC *) (* and check if it is zero. *) (* Zero CRC means OK sector. *) IF Ch <> Timeout THEN BEGIN (* Byte 2 CRC OK *) CRC := Update_CRC( CRC , Ch ); Receive_Xmodem_Sector := ( CRC = 0 ); END (* Byte 2 CRC OK *) ELSE BEGIN (* Byte 2 CRC Timeout *) Display_Receive_Error('Block length error'); BlockL_Errors := BlockL_Errors + 1; END (* Byte 2 CRC Timeout *) END (* Byte 1 CRC OK *) ELSE BEGIN (* Byte 1 CRC Timeout *) Display_Receive_Error('Block length error'); BlockL_Errors := BlockL_Errors + 1; END (* Byte 1 CRC Timeout *); END (* Compute CRC *) ELSE BEGIN (* Receive Checksum *) (* Read sector checksum, see if it matches *) (* what we computed from sector read. *) Async_Receive_With_Timeout( One_Second , Ch ); Receive_Xmodem_Sector := ( Checksum = Ch ); END (* Receive Checksum *); END (* Receive_Xmodem_Sector *); (*----------------------------------------------------------------------*) (* Receive_Telink_Header --- Get Telink block 0 header *) (*----------------------------------------------------------------------*) PROCEDURE Receive_Telink_Header; (*----------------------------------------------------------------------*) (* *) (* Procedure: Receive_Telink_Header *) (* *) (* Purpose: Gets Telink header block 0 (filename+size+date) *) (* *) (* Calling Sequence: *) (* *) (* Receive_Telink_Header; *) (* *) (* Calls: *) (* *) (* Trim *) (* Dir_Convert_Time *) (* Dir_Convert_Date *) (* Draw_Menu_Frame *) (* *) (*----------------------------------------------------------------------*) VAR I : INTEGER; CDate : STRING[8]; CTime : STRING[8]; BEGIN (* Receive_Telink_Header *) RFile_Size := 0.0; RFile_Name := ''; FOR I := 4 DOWNTO 1 DO RFile_Size := RFile_Size * 256.0 + Sector_Data[I]; Blocks_To_Get := ROUND( RFile_Size / 128.0 + 0.49 ); File_Time := Sector_Data[6] SHL 8 OR Sector_Data[5]; File_Date := Sector_Data[8] SHL 8 OR Sector_Data[7]; FOR I := 9 TO 24 DO IF Sector_Data[I] <> 0 THEN RFile_Name := RFile_Name + CHR( Sector_Data[I] ); RFile_Name := TRIM( Rfile_Name ); Draw_Menu_Frame( 15, 10, 78, 23, Menu_Frame_Color, Menu_Text_Color, 'Receive file ' + FileName + ' using ' + Tname ); Dir_Convert_Time( File_Time, CTime ); Dir_Convert_Date( File_Date, CDate ); Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color, Menu_Text_Color, '' ); (* Headings for Ymodem information *) Window( 16, 4, 77, 8 ); GoToXY( 1 , 1 ); WRITE(' File name: ',FileName); GoToXY( 1 , 2 ); WRITE(' File Size in bytes: ',RFile_Size:8:0); GoToXY( 1 , 3 ); WRITE(' File Size in blocks: ',Blocks_To_Get:8:0); GoToXY( 1 , 4 ); WRITE(' File creation time: ',CTime ); GoToXY( 1 , 5 ); WRITE(' File creation date: ',CDate ); (* Restore previous window *) Window( 16, 11, 77, 21 ); IF RFile_Size > 0.0 THEN BEGIN Display_Time := TRUE; Time_To_Send := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate ); Time_Per_Block := Time_To_Send / Blocks_To_Get; Initialize_Receive_Display; Truncate_File := TRUE; END; (* Prevent clobbers in host mode *) IF Host_Mode THEN Stop_Receive := Stop_Receive OR Scan_Xfer_List( FileName ) OR ( FileName = 'PIBTERM.USF' ) OR ( FileName = 'PIBTERM.XFR' ) OR ( FileName = 'PIBTERM.MSG' ) OR ( FileName = 'PIBTERM.CMT' ) OR ( FileName = 'PIBTERM.CMT' ); END (* Receive_Telink_Header *); (*----------------------------------------------------------------------*) (* Receive_Ymodem_Header --- Get Ymodem block 0 header *) (*----------------------------------------------------------------------*) PROCEDURE Receive_Ymodem_Header; (*----------------------------------------------------------------------*) (* *) (* Procedure: Receive_Ymodem_Header *) (* *) (* Purpose: Gets Ymodem header block 0 (filename+size+date) *) (* *) (* Calling Sequence: *) (* *) (* Receive_Ymodem_Header *) (* *) (* Calls: *) (* *) (* Draw_Menu_Frame *) (* Dir_Convert_Time *) (* Dir_Convert_Date *) (* Open_Receiving_File *) (* *) (*----------------------------------------------------------------------*) VAR I : INTEGER; CTime : STRING[10]; CDate : STRING[10]; Year : INTEGER; Month : INTEGER; Day : INTEGER; Hour : INTEGER; Mins : INTEGER; Secs : INTEGER; (*----------------------------------------------------------------------*) PROCEDURE Get_Ymodem_Date( Date : REAL; VAR Year : INTEGER; VAR Month : INTEGER; VAR Day : INTEGER; VAR Hour : INTEGER; VAR Mins : INTEGER; VAR Secs : INTEGER ); CONST Secs_Per_Year = 31536000.0; Secs_Per_Leap_Year = 31622400.0; Secs_Per_Day = 86400.0; Secs_Per_Hour = 3600.0; Secs_Per_Minute = 60.0; VAR RDate : REAL; T : REAL; (* STRUCTURED *) CONST Days_Per_Month : ARRAY[1..12] OF BYTE = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); BEGIN (* Get_Ymodem_Date *) Year := 1970; Month := 1; RDate := Date - GMT_Difference * Secs_Per_Hour; WHILE( RDate > 0.0 ) DO BEGIN IF ( Year MOD 4 ) = 0 THEN T := Secs_Per_Leap_Year ELSE T := Secs_Per_Year; RDate := RDate - T; Year := Year + 1; END; RDate := RDate + T; Year := Year - 1; IF ( Year MOD 4 ) = 0 THEN Days_Per_Month[2] := 29 ELSE Days_Per_Month[2] := 28; WHILE( RDate > 0.0 ) DO BEGIN T := Days_Per_Month[Month] * Secs_Per_Day; RDate := RDate - T; Month := Month + 1; END; RDate := RDate + T; Month := Month - 1; Day := TRUNC( INT( ( Rdate + Secs_Per_Day - 1 ) / Secs_Per_Day ) ); Rdate := Rdate - ( Day - 1 ) * Secs_Per_Day; Hour := TRUNC( INT( Rdate / Secs_Per_Hour ) ); Rdate := Rdate - Hour * Secs_Per_Hour; Mins := TRUNC( INT( Rdate / Secs_Per_Minute ) ); Secs := TRUNC( Rdate - Mins * Secs_Per_Minute ); END (* Get_Ymodem_Date *); (*----------------------------------------------------------------------*) BEGIN (* Receive_Ymodem_Header *) RFile_Size := 0.0; RFile_Date := 0.0; RFile_Name := ''; File_Time := 0; File_Date := 0; (* Pick up file name *) I := 1; WHILE( Sector_Data[I] <> NUL ) DO BEGIN RFile_Name := RFile_Name + CHR( Sector_Data[I] ); I := I + 1; END; (* If null file name, this means *) (* end of Ymodem batch, so quit. *) IF LENGTH( RFile_Name ) = 0 THEN BEGIN Null_File_Name := TRUE; EXIT; END; (* Pick up file size *) I := I + 1; WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO BEGIN RFile_Size := RFile_Size * 10.0 + ORD( Sector_Data[I] ) - ORD('0'); I := I + 1; END; I := I + 1; WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO BEGIN RFile_Date := RFile_Date * 8.0 + ORD( Sector_Data[I] ) - ORD('0'); I := I + 1; END; IF RFile_Date > 0 THEN BEGIN Get_Ymodem_Date( RFile_Date, Year, Month, Day, Hour, Mins, Secs ); File_Time := Hour SHL 11 OR Mins SHL 5 OR ( Secs DIV 2 ); File_Date := MAX( Year - 1980 , 0 ) SHL 9 + Month SHL 5 + Day; Dir_Convert_Time( File_Time, CTime ); Dir_Convert_Date( File_Date, CDate ); END; Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color, Menu_Text_Color, 'Receive file ' + RFile_Name + ' using ' + Tname ); (* Headings for Ymodem information *) Window( 16, 4, 77, 8 ); GoToXY( 1 , 1 ); WRITE(' File name: ',RFile_Name); Blocks_To_Get := ROUND( RFile_Size / 1024.0 + 0.49 ); IF RFile_Size > 0.0 THEN BEGIN GoToXY( 1 , 2 ); WRITE(' File Size in bytes: ',RFile_Size:8:0); GoToXY( 1 , 3 ); WRITE(' File Size in 1K blocks: ',Blocks_To_Get:8:0); END; Blocks_To_Get := ROUND( RFile_Size / 128.0 + 0.49 ); IF File_Date > 0 THEN BEGIN GoToXY( 1 , 4 ); WRITE(' File creation time: ',CTime ); GoToXY( 1 , 5 ); WRITE(' File creation date: ',CDate ); END; FileName := RFile_Name; (* Restore previous window *) Window( 16, 11, 77, 21 ); IF Rfile_Size > 0.0 THEN BEGIN Display_Time := TRUE; Time_To_Send := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate ); Time_Per_Block := Time_To_Send / Blocks_To_Get; Initialize_Receive_Display; Truncate_File := ( RFile_Size > 0.0 ); END; (* Prevent clobbers in host mode *) IF Host_Mode THEN Stop_Receive := Stop_Receive OR Scan_Xfer_List( FileName ) OR ( FileName = 'PIBTERM.USF' ) OR ( FileName = 'PIBTERM.XFR' ) OR ( FileName = 'PIBTERM.MSG' ) OR ( FileName = 'PIBTERM.CMT' ) OR ( FileName = 'PIBTERM.CMT' ); (* Open reception file *) IF ( NOT Stop_Receive ) THEN Open_Receiving_File; END (* Receive_Ymodem_Header *); (*----------------------------------------------------------------------*) (* Wait_For_SOH --- Wait for start for start of XMODEM block *) (*----------------------------------------------------------------------*) PROCEDURE Wait_For_SOH( Wait_Time : INTEGER; VAR Initial_Ch : INTEGER; VAR Stop_Receive : BOOLEAN ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Wait_For_SOH *) (* *) (* Purpose: Waits for SOH/STX/SYN initiating Xmodem block *) (* *) (* Calling Sequence: *) (* *) (* Wait_For_SOH( Wait_Time : INTEGER; *) (* VAR Initial_Ch : INTEGER; *) (* VAR Stop_Receive : BOOLEAN ); *) (* *) (* Wait_Time --- time to wait for character in seconds *) (* Initial_Ch --- returned initial character *) (* Stop_Receive --- TRUE if Alt-R hit to stop transfer *) (* *) (* Calls: *) (* *) (* Async_Receive_With_Timeout *) (* *) (*----------------------------------------------------------------------*) VAR Kbd_Ch: CHAR; ITime : INTEGER; BEGIN (* Wait_For_SOH *) (* If already cancelled transfer, *) (* don't look for more input! *) Initial_Ch := TimeOut; IF Stop_Receive THEN EXIT; (* Look for start of Xmodem block *) ITime := 0; REPEAT ITime := ITime + 1; Async_Receive_With_Timeout( One_Second, Initial_Ch ); (* Check for keyboard input -- Alt_R *) (* cancels transfer. *) IF KeyPressed THEN BEGIN READ( Kbd, Kbd_Ch ); IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN BEGIN READ( Kbd, Kbd_Ch ); Alt_R_Pressed := ( ORD( Kbd_Ch ) = Alt_R ); Stop_Receive := Stop_Receive OR Alt_R_Pressed; END; END; (* Also stop transfer if carrier drops *) IF Async_Carrier_Drop THEN BEGIN Stop_Receive := TRUE; Initial_Ch := TimeOut; END; UNTIL ( Stop_Receive OR ( ITime > Wait_Time ) OR ( Initial_Ch <> TimeOut ) ); END (* Wait_For_SOH *); (*----------------------------------------------------------------------*) (* Set_File_Date_And_Time --- set file date and time stamp *) (*----------------------------------------------------------------------*) PROCEDURE Set_File_Date_And_Time; VAR OLd_Time : INTEGER; Old_Date : INTEGER; Err : INTEGER; File_Handle: INTEGER; (*----------------------------------------------------------------------*) PROCEDURE Set_File_Time_Error; BEGIN (* Set_File_Time_Error *) GoToXY( 25 , 10 ); WRITE('Could not set date/time for file.'); ClrEol; DELAY( One_Second_Delay ); END (* Set_File_Time_Error *); (*----------------------------------------------------------------------*) BEGIN (* Set_File_Date_And_Time *) Err := Open_File_Handle( FileName, Access_Read_And_Write_Mode, File_Handle ); IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN Set_File_Time_Error ELSE BEGIN Err := Dir_Set_File_Date_And_Time( File_Handle, File_Date, File_Time ); IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN Set_File_Time_Error ELSE BEGIN Err := Close_File_Handle( File_Handle ); IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN Set_File_Time_Error; END; END; END (* Set_File_Date_And_Time *); (*----------------------------------------------------------------------*) (* Write_File_Data --- Write received data to file *) (*----------------------------------------------------------------------*) PROCEDURE Write_File_Data; PROCEDURE Do_Actual_Write( Write_Count: INTEGER ); BEGIN (* Do_Actual_Write *) IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND Truncate_File THEN Write_Count := TRUNC( RFile_Size - Rfile_Size_2 ); Err := Write_File_Handle( XFile_Handle, Write_Buffer^, Write_Count ); IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN BEGIN GoToXY( 25 , 10 ); WRITE('Error in writing to disk, transfer cancelled.'); ClrEol; DELAY( One_Second_Delay ); Stop_Receive := TRUE; END; RFile_Size_2 := RFile_Size_2 + Write_Count; END (* Do_Actual_Write *); (*----------------------------------------------------------------------*) BEGIN (* Write_File_Data *) (* Write directly from sector *) (* if not long buffer used *) IF ( NOT Long_Buffer ) THEN Do_Actual_Write( Sector_Length ) (* Store sector data in long *) (* buffer and write file if *) (* necessary. *) ELSE BEGIN IF ( Buffer_Pos + Sector_Length ) > Buffer_Length THEN BEGIN Do_Actual_Write( Buffer_Pos ); Buffer_Pos := 0; END; MOVE( Sector_Data, Write_Buffer^[ Buffer_Pos + 1 ], Sector_Length ); Buffer_Pos := Buffer_Pos + Sector_Length; END; END (* Write_File_Data *); (*----------------------------------------------------------------------*) (* Cancel_Transfer --- Cancel transfer *) (*----------------------------------------------------------------------*) PROCEDURE Cancel_Transfer; BEGIN (* Cancel_Transfer *) (* Purge reception *) Async_Purge_Buffer; (* Send five cancels, then five *) (* backspaces. *) Async_Send( CHR( CAN ) ); Async_Send( CHR( CAN ) ); Async_Send( CHR( CAN ) ); Async_Send( CHR( CAN ) ); Async_Send( CHR( CAN ) ); Async_Send( CHR( BS ) ); Async_Send( CHR( BS ) ); Async_Send( CHR( BS ) ); Async_Send( CHR( BS ) ); Async_Send( CHR( BS ) ); END (* Cancel_Transfer *); (*----------------------------------------------------------------------*) BEGIN (* Receive_Xmodem_File *) (* Open display window for transfer *) Save_Screen( Saved_Screen ); CASE Transfer_Protocol OF Xmodem_Chk : Tname := 'Xmodem (Checksum)'; Xmodem_Crc : Tname := 'Xmodem (CRC)'; Telink : Tname := 'Telink'; Modem7_Chk : Tname := 'Modem7 (Checksum)'; Modem7_CRC : Tname := 'Modem7 (CRC)'; Ymodem : Tname := 'Ymodem'; Ymodem_Batch : Tname := 'Ymodem Batch'; END (* CASE *); IF FileName = '' THEN Menu_Title := 'Receive file using ' + Tname ELSE Menu_Title := 'Receive file ' + FileName + ' using ' + Tname; Draw_Menu_Frame( 15, 10, 78, 22, Menu_Frame_Color, Menu_Text_Color, Menu_Title ); Window( 16, 11, 77, 21 ); (* Initialize status display information *) SOH_Errors := 0; BlockL_Errors := 0; BlockN_Errors := 0; Comple_Errors := 0; Timeout_Errors := 0; Resend_Errors := 0; CRC_Errors := 0; Display_Time := FALSE; Initialize_Receive_Display; (* Current sector = 0 *) Sector_Number := 0; Sector_Count := 0; Sector_Prev := 0; Sector_Length := 128; (* Overall error count = 0 *) Error_Count := 0; (* CRC tries *) CRC_Tries := 0; (* How long to wait for SOH *) SOH_Time := Ten_Seconds; (* Assume file size not sent *) Truncate_File := FALSE; (* Assume file size, date not sent *) RFile_Size := 0.0; RFile_Size_2 := 0.0; RFile_Date := 0.0; File_Date := 0; File_Time := 0; (* Assume file name not sent *) RFile_Name := ''; (* Assume transfer fails *) OK_Transfer := FALSE; (* Assume block 0 not found *) Block_Zero := FALSE; (* Starting time *) Start_Time := TimeOfDay; (* User intervention flag *) Alt_R_Pressed := FALSE; (* Serious error flag *) Stop_Receive := FALSE; (* Not null file name *) Null_File_Name := FALSE; (* Allocate buffer if requested *) (* otherwise use sector data area *) (* directly. *) IF Max_Write_Buffer > 1024 THEN BEGIN Buffer_Length := Max_Write_Buffer; Long_Buffer := TRUE; GetMem( Write_Buffer , Buffer_Length ); END ELSE BEGIN Long_Buffer := FALSE; Write_Buffer := ADDR( Sector_Data ); END; (* Empty write buffer *) Buffer_Pos := 0; (* Open reception file now if possible *) RFile_Open := FALSE; IF FileName <> '' THEN BEGIN Open_Receiving_File; IF Stop_Receive THEN BEGIN Cancel_Transfer; DELAY( Two_Second_Delay ); Restore_Screen( Saved_Screen ); Reset_Global_Colors; EXIT; END; END; (* Begin XMODEM loop *) REPEAT (* Reset error flag *) Error_flag := FALSE; (* Look for SOH *) REPEAT IF Sector_Count = 0 THEN BEGIN Use_CRC := Use_CRC AND ( CRC_Tries < 4 ); (* Purge reception *) Async_Purge_Buffer; (* Indicate XMODEM type *) IF Use_Crc THEN Async_Send( 'C' ) ELSE Async_Send( CHR( NAK ) ); CRC_Tries := CRC_Tries + 1; GoToXY( 1 , 8 ); IF ( NOT Use_Crc ) THEN WRITELN(' Checksum errors :') ELSE WRITELN(' CRC errors :'); END; Wait_For_SOH( SOH_Time, Initial_Ch , Stop_Receive ); (* If CAN found, insist on *) (* at least two CANs in a row *) (* before cancelling transfer *) IF Initial_Ch = CAN THEN Wait_For_SOH( SOH_Time, Initial_Ch , Stop_Receive ); UNTIL ( Initial_Ch = SOH ) OR ( Initial_Ch = EOT ) OR ( Initial_Ch = CAN ) OR ( Initial_Ch = SYN ) OR ( Initial_Ch = STX ) OR ( Initial_Ch = TimeOut ) OR ( Error_Count > Max_Errors ) OR ( Stop_Receive ); (* Something wrong already -- *) (* cancel the transfer. *) IF Stop_Receive THEN BEGIN IF NOT Async_Carrier_Detect THEN BEGIN Display_Receive_Error('Carrier dropped.'); DELAY( Two_Second_Delay ); END; END (* Timed out -- no SOH found *) ELSE IF Initial_Ch = Timeout THEN BEGIN Display_Receive_Error( 'Time out error, no SOH'); Timeout_Errors := Timeout_Errors + 1; END (* SYN found -- Telink header *) (* SOH found -- start of XMODEM block *) (* STX found -- start of Ymodem block *) ELSE IF ( Initial_Ch = SOH ) OR ( Initial_Ch = SYN ) OR ( Initial_Ch = STX ) THEN BEGIN (* SOH found *) (* Pick up sector number *) IF Initial_Ch = STX THEN Sector_Length := 1024 ELSE Sector_Length := 128; Async_Receive_With_Timeout( One_Second , Ch ); IF Ch = TimeOut THEN BEGIN BlockL_Errors := BlockL_Errors + 1; Display_Receive_Error('Short block'); END; Sector_Number := Ch; (* Complement of sector number *) Async_Receive_With_Timeout( One_Second , Ch ); IF Ch = TimeOut THEN BEGIN BlockL_Errors := BlockL_Errors + 1; Display_Receive_Error('Short block'); END; Sector_Comp := Ch; (* See if they add up properly *) IF ( ( Sector_Number + Sector_Comp ) = 255 ) THEN BEGIN (* Sector number and complement match *) Sector_Prev1 := Sector_Prev + 1; Block_Zero := ( Sector_Count = 0 ) AND ( Sector_Number = 0 ) AND ( ( Initial_Ch = SYN ) OR ( Transfer_Protocol IN [Ymodem, Ymodem_Batch] ) ); IF ( Sector_Number = Sector_Prev1 ) OR Block_Zero THEN BEGIN (* Correct sector found *) Use_CRC_2 := Use_CRC AND ( NOT ( Block_Zero AND ( Transfer_Protocol = Telink ) ) ); IF Receive_Xmodem_Sector( Use_CRC_2 ) THEN IF ( NOT Block_Zero ) THEN BEGIN (* Checksum/CRC OK *) Write_File_Data; Error_Count := 0; Sector_Count := Sector_Count + 1; Sector_Prev := Sector_Number; Async_Send( CHR( ACK ) ); END (* Checksum/CRC OK *) ELSE (* Telink/Ymodem block 0 *) BEGIN IF ( Initial_Ch = SYN ) THEN Receive_Telink_Header ELSE IF ( Transfer_Protocol IN [Ymodem, Ymodem_Batch] ) THEN Receive_Ymodem_Header; IF ( NOT Stop_Receive ) THEN BEGIN Async_Send( CHR( ACK ) ); Error_Count := 0; END; END ELSE BEGIN (* Checksum/CRC error *) CRC_Errors := CRC_Errors + 1; IF Use_Crc THEN Display_Receive_Error('CRC error') ELSE Display_Receive_Error('Checksum error'); END (* Checksum/CRC error *) END (* Correct sector found *) ELSE IF ( Sector_Number = Sector_Prev ) THEN BEGIN (* Duplicate sector *) Display_Receive_Error('Duplicate block '); Resend_Errors := Resend_Errors + 1; Async_Send( CHR( ACK ) ); END (* Duplicate sector *) ELSE BEGIN Display_Receive_Error('Synchronization error'); BlockN_Errors := BlockN_Errors + 1; END; END (* Sector # and complement match *) ELSE BEGIN (* Sector # and complement do not match *) Display_Receive_Error('Sector number error'); Comple_Errors := Comple_Errors + 1; END (* Sector # and complement do not match *); END (* SOH Found *) ELSE IF ( Initial_Ch <> EOT ) THEN BEGIN Display_Receive_Error('SOH not found'); SOH_Errors := SOH_Errors + 1; END; IF Error_Flag THEN BEGIN Error_Count := Error_Count + 1; Async_Purge_Buffer; Async_Send( CHR( NAK ) ); END; IF Display_Time THEN BEGIN IF ( NOT Error_Flag ) THEN Time_To_Send := Time_To_Send - Time_Per_Block * ( Sector_Length / 128 ); IF Time_To_Send < 0.0 THEN Time_To_Send := 0.0; END; Update_Xmodem_Receive_Display; UNTIL ( Initial_Ch = EOT ) OR ( Initial_Ch = CAN ) OR ( Stop_Receive ) OR ( Null_File_Name ) OR ( Error_Count > Max_Errors ); (* If serious error or Alt_R hit, *) (* stop download. *) IF ( Stop_Receive ) THEN BEGIN Cancel_Transfer; IF Alt_R_Pressed THEN BEGIN GoToXY( 25 , 10 ); WRITE('Alt-R key hit -- reception cancelled.'); Writelne('ALT-R key hit, reception cancelled.', FALSE); ClrEol; END; END (* Null file name -- end of batch *) ELSE IF Null_File_Name THEN BEGIN GoToXY( 25 , 10 ); WRITE('Null file name received.'); Writelne('Null file name received.', FALSE); ClrEol; END (* EOT received, error count OK *) ELSE IF ( Initial_Ch = EOT ) AND ( Error_Count <= Max_Errors ) THEN BEGIN (* Acknowledge EOT *) Async_Send( CHR( ACK ) ); (* Write any remaining data in buffer *) IF Buffer_Pos > 0 THEN BEGIN Write_Count := Buffer_Pos; IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND Truncate_File THEN Write_Count := TRUNC( RFile_Size - Rfile_Size_2 ); Err := Write_File_Handle( XFile_Handle, Write_Buffer^, Write_Count ); IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN BEGIN GoToXY( 25 , 10 ); WRITE('Error in writing to disk, file may be bad.'); ClrEol; DELAY( One_Second_Delay ); END; RFile_Size_2 := RFile_Size_2 + Write_Count; END; GoToXY( 2 , 10 ); WRITE('Transfer complete; '); End_Time := TimeOfDay; IF RFile_Size > 0.0 THEN IF RFile_Size <= RFile_Size_2 THEN RFile_Size_2 := RFile_Size; IF End_Time > Start_Time THEN BEGIN Effective_Rate := RFile_Size_2 / ( End_Time - Start_Time ); WRITE('transfer rate was ',Effective_Rate:6:1,' CPS'); ClrEol; OK_Transfer := TRUE; END; Writelne('Received file ' + FileName , FALSE ); END ELSE IF ( Initial_Ch = CAN ) THEN BEGIN GoToXY( 25 , 10 ); WRITE('Transmitter cancelled file transfer.'); Writelne('Transmitter cancelled file transfer.', FALSE); ClrEol; END ELSE BEGIN GoToXY( 25 , 10 ); WRITE('Transfer Cancelled'); Writelne('Transfer cancelled', FALSE); ClrEol; END; (* Close transferred file *) Err := Close_File_Handle( XFile_Handle ); I := Int24Result; (* Set file time and date if Telink *) (* or Ymodem *) IF ( File_Date > 0 ) AND Use_Time_Sent THEN Set_File_Date_And_Time; DELAY( Two_Second_Delay ); (* Remove download buffer *) IF Long_Buffer THEN FREEMEM( Write_Buffer , Buffer_Length ); (* Remove XMODEM window *) Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* Receive_Xmodem_File *) ;