(*----------------------------------------------------------------------*) (* Send_Xmodem_File --- Upload file using XMODEM *) (*----------------------------------------------------------------------*) PROCEDURE Send_Xmodem_File( Use_CRC : BOOLEAN ); (*----------------------------------------------------------------------*) (* *) (* Procedure: Send_Xmodem_File *) (* *) (* Purpose: Uploads file to remote host using XMODEM protocol. *) (* *) (* Calling Sequence: *) (* *) (* Send_Xmodem_File( Use_CRC ); *) (* *) (* Use_CRC --- TRUE to use Cyclic redundancy check version *) (* of XMODEM; FALSE to use Checksum version. *) (* *) (* Remarks: *) (* *) (* The file's existence should have been already checked *) (* prior to calling this routine. *) (* *) (* 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. *) (* *) (* Calls: KeyPressed *) (* Async_Send *) (* Async_Receive *) (* Compute_Crc *) (* Draw_Menu_Frame *) (* Save_Screen *) (* Restore_Screen *) (* Async_Open *) (* *) (*----------------------------------------------------------------------*) (* If this threshhold value x number *) (* of bad blocks > number of good *) (* blocks, reduce block size to 128 *) CONST Bad_Threshhold = 6; VAR Xfile_Byte : FILE OF BYTE (* Same as transfer file, file size *); XFile_Handle : INTEGER (* File handle for file to transfer *); I : INTEGER (* Loop index *); Tries : INTEGER (* # of tries sending current sector *); Checksum : INTEGER (* Sector checksum *); Crc : INTEGER (* Cyclic redundancy check *); Ch : INTEGER (* Character received from COM port *); Sector_Length : INTEGER (* # chars to send *); Kbd_Ch : CHAR (* Absorbs keyboard characters *); Send_Errors : INTEGER (* Counts transfer errors *); Blocks_To_Send: INTEGER (* Number of blocks to send *); Sector_Count : INTEGER (* Sector count -- no wrap at 255 *); Transfer_Time : INTEGER (* Transfer time in seconds *); Starting_Time : INTEGER (* Starting transfer time *); Trans_Hours : INTEGER (* Transfer time -- hours component *); Trans_Minutes : INTEGER (* Transfer time -- mins. component *); Trans_Seconds : INTEGER (* Transfer time -- secs. component *); S_Hours : STRING[2] (* Hours in character form *); S_Minutes : STRING[2] (* Minutes in character form *); S_Seconds : STRING[2] (* Seconds in character form *); Time_To_Send : REAL (* Time in seconds to transfer file *); Time_Per_Blk : REAL (* Time in seconds to transfer block *); Effective_Rate: REAL (* Effective baud rate of transfer *); Start_Time : REAL (* Starting time of transfer *); End_Time : REAL (* Ending time of transfer *); NRead : INTEGER (* Records actually read from file *); EOF_Xfile : BOOLEAN (* EOF encountered on file to send *); Tname : STRING[20] (* Transfer type *); Sector_Size1 : INTEGER (* Sector size + 1 *); Sector_Size2 : INTEGER (* Sector size + 2 *); Alt_S_Found : BOOLEAN (* TRUE if alt_s entered *); Max_Tries : INTEGER (* Max. number of retries *); R_Sector_Size : REAL (* Sector size as reals *); Header_Ch : CHAR (* Block header character *); New_Header_Ch : CHAR (* Revised block header if downshift *); Bad_Sectors : INTEGER (* Count of bad sectors *); Good_Sectors : INTEGER (* Count of good sectors *); ITime : INTEGER (* Counter for wait loops *); (*----------------------------------------------------------------------*) (* Update_Xmodem_Send_Display --- Update display of Xmodem sending *) (*----------------------------------------------------------------------*) PROCEDURE Update_Xmodem_Send_Display; BEGIN (* Update_Xmodem_Send_Display *) GoToXY( 26 , 4 ); WRITE( Sector_Count ); GoToXY( 26 , 5 ); WRITE( Send_Errors ); GoToXY( 26 , 6 ); WRITE( TimeString( Time_To_Send ) ); END (* Update_Xmodem_Send_Display *); (*----------------------------------------------------------------------*) (* Display_Send_Error --- Display XMODEM sending error *) (*----------------------------------------------------------------------*) PROCEDURE Display_Send_Error( Err_Text: AnyStr; Display_Block: BOOLEAN ); BEGIN (* Display_Send_Error *) GoToXY( 26 , 8 ); WRITE(Err_Text); IF Display_Block THEN WRITE( ' at/before block ', MAX( Sector_Count - 1 , 0 ) ); ClrEol; END (* Display_Send_Error *); (*----------------------------------------------------------------------*) (* Check_Keyboard --- Check for keyboard entry *) (*----------------------------------------------------------------------*) PROCEDURE Check_Keyboard; BEGIN (* Check_Keyboard *) IF KeyPressed THEN BEGIN READ( Kbd, Kbd_Ch ); IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN BEGIN READ( Kbd , Kbd_Ch ); Alt_S_Found := ( ORD( Kbd_Ch ) = Alt_S ); Stop_Send := Stop_Send OR Alt_S_Found; END; END; END (* Check_Keyboard *); (*----------------------------------------------------------------------*) (* Xmodem_Wait_For_Ch --- wait 10 seconds for character to appear *) (*----------------------------------------------------------------------*) PROCEDURE Xmodem_Wait_For_Ch( VAR Ch: INTEGER ); BEGIN (* Xmodem_Wait_For_Ch *) ITime := 0; REPEAT ITime := ITime + 1; Async_Receive_With_Timeout( One_Second , Ch ); Check_KeyBoard; UNTIL ( Ch <> TimeOut ) OR ( ITime >= Ten_Seconds ) OR Stop_Send; END (* Xmodem_Wait_For_Ch *); (*----------------------------------------------------------------------*) (* Send_Xmodem_Block --- send out Xmodem block *) (*----------------------------------------------------------------------*) PROCEDURE Send_Xmodem_Block; VAR I : INTEGER; ITime : INTEGER; BEGIN (* Send_Xmodem_Block *) (* Reset error count to zero *) Tries := 0; REPEAT (* Send 1st char of block *) Async_Send( Header_Ch ); (* Send block number and complement *) Async_Send( CHR( Sector_Number ) ); Async_Send( CHR( 255 - Sector_Number ) ); (* Transmit Sector Data *) FOR I := 1 TO Sector_Length DO Async_Send( CHR( Sector_Data[ I ] ) ); (* Purge receive buffer *) Async_Purge_Buffer; (* Increment count of tries to send *) (* for this sector. *) Tries := Tries + 1; (* Pick up a character -- should be ACK *) Xmodem_Wait_For_Ch( Ch ); (* If CAN, insist on another *) IF Ch = CAN THEN Xmodem_Wait_For_Ch( Ch ); IF Ch <> ACK THEN BEGIN Display_Send_Error('No ACK', TRUE); Send_Errors := Send_Errors + 1; END; (* Update display *) Update_Xmodem_Send_Display; UNTIL ( Ch = ACK ) OR ( Ch = CAN ) OR ( Tries > Max_Tries ) OR ( Stop_Send ); END (* Send_Xmodem_Block *); (*----------------------------------------------------------------------*) (* Send_Telink_Header --- send out special block 0 for Telink *) (*----------------------------------------------------------------------*) PROCEDURE Send_Telink_Header; BEGIN (* Send_Telink_Header *) (* Always send TELINK in Checksum mode *) Max_Tries := 3; I := Sector_Length; Sector_Length := 129; Header_Ch := CHR( SYN ); Send_Xmodem_Block; Sector_Length := I; Max_Tries := 10; If ( Ch = ACK ) THEN BEGIN GoToXY( 26 , 8 ); WRITE('Telink header accepted.'); ClrEol; END ELSE BEGIN GoToXY( 26 , 8 ); WRITE('Telink header not accepted.'); ClrEol; END END (* Send_Telink_Header *); (*----------------------------------------------------------------------*) (* Send_Ymodem_Header --- send out special block 0 for Ymodem *) (*----------------------------------------------------------------------*) PROCEDURE Send_Ymodem_Header; BEGIN (* Send_Ymodem_Header *) (* Always send short block 0 *) Max_Tries := 3; I := Sector_Length; Sector_Length := 130; Header_Ch := CHR( SOH ); Send_Xmodem_Block; Sector_Length := I; Max_Tries := 10; If ( Ch = ACK ) THEN BEGIN GoToXY( 26 , 8 ); WRITE('Ymodem header accepted.'); ClrEol; END ELSE BEGIN GoToXY( 26 , 8 ); WRITE('Ymodem header not accepted.'); ClrEol; END END (* Send_Ymodem_Header *); (*----------------------------------------------------------------------*) (* Cancel_Transfer --- Cancel upload *) (*----------------------------------------------------------------------*) 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 (* Send_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 *); Draw_Menu_Frame( 15, 10, 78, 19, Menu_Frame_Color, Menu_Text_Color, 'Send file ' + FileName + ' using ' + Tname ); (* Headings for status information *) Window( 16, 11, 77, 18 ); ASSIGN( Xfile_Byte , FileName ); (*$I-*) RESET ( Xfile_Byte ); (*$I+*) IF ( Int24Result <> 0 ) THEN BEGIN WRITE('Cannot open file to send, transfer cancelled.'); Cancel_Transfer; DELAY( One_Second_Delay ); Restore_Screen( Saved_Screen ); Reset_Global_Colors; EXIT; END; (* Determine sector size *) IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN Sector_Size := 1024 ELSE Sector_Size := 128; Sector_Size1 := Sector_Size + 1; Sector_Size2 := Sector_Size + 2; IF Use_Crc THEN Sector_Length := Sector_Size2 ELSE Sector_Length := Sector_Size1; (* Number of retries of bad block *) Max_Tries := 20; (* Figure approx. time for upload *) Blocks_To_Send := ROUND( ( LongFileSize( Xfile_Byte ) / Sector_Size ) + 0.49 ); Time_To_Send := Blocks_To_Send * ( Sector_Size DIV 128 ) * ( Trans_Time_Val / Baud_Rate ); Time_Per_Blk := Time_To_Send / Blocks_To_Send; (*$I-*) CLOSE ( Xfile_Byte ); (*$I+*) I := Int24Result; (* Headings for status information *) WRITELN(' Blocks to send : ', Blocks_To_Send); WRITELN(' Approx. transfer time : ', TimeString( Time_To_Send ) ); WRITELN(' '); WRITELN(' Sending block : '); WRITELN(' Errors : '); WRITELN(' Time remaining : ', TimeString( Time_To_Send ) ); WRITELN(' '); WRITE (' Last status message : '); (* Open file to send *) I := Open_File_Handle( FileName, Access_Read_Mode, XFile_Handle ); IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN BEGIN WRITE('Cannot open file to send, transfer cancelled.'); Cancel_Transfer; DELAY( One_Second_Delay ); Restore_Screen( Saved_Screen ); Reset_Global_Colors; EXIT; END; (* Sector #s start at 1, wrap at 255 *) Sector_Number := 0; Sector_Count := 0; (* No errors yet *) Send_Errors := 0; (* Set TRUE if errors halt transfer *) Stop_Send := FALSE; (* Starting time for transfer *) Start_Time := TimeOfDay; (* Set EOF on Xfile to FALSE *) EOF_Xfile := FALSE; (* Set Alt_S encountered off *) Alt_S_Found := FALSE; (* No retries yet *) Tries := 0; (* Get initial character *) GoToXY( 26 , 8 ); WRITE('Waiting for NAK/C --- '); ClrEol; (* Purge receive buffer *) Async_Purge_Buffer; (* Look for NAK or C *) REPEAT Xmodem_Wait_For_Ch( Ch ); (* If CAN, insist on another *) IF Ch = CAN THEN Xmodem_Wait_For_Ch( Ch ); Tries := Tries + 1; Check_KeyBoard; Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect ); UNTIL ( Tries > Max_Tries ) OR ( Ch = NAK ) OR ( Ch = ORD( 'C' ) ) OR ( Ch = TimeOut ) OR ( Ch = CAN ) OR Stop_Send; IF ( Ch = TimeOut ) OR ( Tries > Max_Tries ) OR ( Ch = CAN ) THEN BEGIN GoToXY( 26 , 51 ); WRITE('Not Received '); ClrEol; Stop_Send := TRUE; END ELSE IF ( Ch = NAK ) THEN Use_Crc := FALSE ELSE IF ( Ch = ORD( 'C' ) ) THEN Use_Crc := TRUE; (* Indicate OK reception *) IF ( NOT Stop_Send ) THEN BEGIN GoToXY( 26 , 51 ); WRITE('Received '); ClrEol; (* Set header character *) IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN Header_Ch := CHR( STX ) ELSE Header_Ch := CHR( SOH ); New_Header_Ch := Header_Ch; (* If Telink or Ymodem, send the *) (* special initial sector, already *) (* prepared in Send_Modem7_File or *) (* Send_Ymodem_File *) IF Transfer_Protocol = Ymodem_Batch THEN Send_Ymodem_Header ELSE IF Transfer_Protocol = Telink THEN Send_Telink_Header; END; (* Begin loop over blocks in file *) REPEAT (* See if Alt-S hit, ending transfer *) Check_Keyboard; Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect ); IF ( NOT Stop_Send ) THEN BEGIN (* Send the next sector *) (* Set block header character *) Header_Ch := New_Header_Ch; (* Read Sector_size chars from file *) (* to be sent. *) NRead := Sector_Size; I := Read_File_Handle( XFile_Handle, Sector_Data, NRead ); (* Check for error *) IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN BEGIN Display_Send_Error('Cannot read data from file', TRUE); Stop_Send := TRUE; END (* If no chars. read, then EOF *) ELSE IF NRead <= 0 THEN EOF_Xfile := TRUE ELSE BEGIN (* NOT Eof *) (* Compute Checksum or Crc *) IF Use_Crc THEN BEGIN (* Use CRC *) Sector_Data[ Sector_Size1 ] := 0; Sector_Data[ Sector_Size2 ] := 0; Crc := 0; FOR I := 1 TO Sector_Size2 DO Crc := Update_Crc( Crc , Sector_Data[I] ); Sector_Data[ Sector_Size1 ] := HI( Crc ); Sector_Data[ Sector_Size2 ] := LO( Crc ); END (* Use CRC *) ELSE BEGIN (* Use Checksum *) Checksum := 0; FOR I := 1 TO Sector_Size DO Checksum := ( Checksum + Sector_Data[ I ] ) MOD 256; Sector_Data[ Sector_Size1 ] := Checksum; END (* Use Checksum *); (* Increment sector number *) Sector_Number := Sector_Number + 1; Sector_Count := Sector_Count + 1; (* Send the block *) Send_Xmodem_Block; (* Update transmit time and counts *) (* of good/bad sectors; also shift *) (* to 128 byte sectors in Ymodem *) (* if ratio of bad/good > 1/6. *) IF Ch = ACK THEN BEGIN Time_To_Send := Time_To_Send - Time_Per_Blk; IF Time_To_Send < 0.0 THEN Time_To_Send := 0.0; Good_Sectors := Good_Sectors + 1; END ELSE BEGIN Bad_Sectors := Bad_Sectors + 1; IF ( Bad_Threshhold * Bad_Sectors > Good_Sectors ) THEN BEGIN New_Header_Ch := CHR( SOH ); Sector_Size := 128; Sector_Size1 := Sector_Size + 1; Sector_Size2 := Sector_Size + 2; IF Use_Crc THEN Sector_Length := Sector_Size2 ELSE Sector_Length := Sector_Size1; END; END; END (* Not EOF *) END (* Send Next Sector *); UNTIL ( EOF_Xfile ) OR ( Tries = Max_Tries ) OR ( Ch = CAN ) OR ( Stop_Send ); (* Send CANs to host to cancel *) (* transfer *) IF Stop_Send THEN IF Async_Carrier_Detect THEN Cancel_Transfer; IF Tries >= Max_Tries THEN (* We failed to send a sector correctly *) Display_Send_Error('No ACK ever received.' , FALSE) ELSE IF ( Ch = CAN ) THEN (* Receiver cancelled transmission *) Display_Send_Error('Receiver cancelled transmission.',FALSE) ELSE IF Alt_S_Found THEN (* User cancelled transmission *) Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE) ELSE IF ( NOT Stop_Send ) THEN (* We sent everything, try sending EOT *) BEGIN GoToXY( 26 , 8 ); WRITE('Waiting for ACK of EOT'); ClrEol; Tries := 0; REPEAT Async_Send( CHR( EOT ) ); Tries := Tries + 1; Xmodem_Wait_For_Ch( Ch ); IF Ch = CAN THEN Xmodem_Wait_For_Ch( Ch ); Update_Xmodem_Send_Display; UNTIL ( Ch = ACK ) OR ( Tries = Max_Tries ) OR ( Ch = CAN ) OR Stop_Send; IF Tries = Max_Tries THEN Display_Send_Error('No ACK on EOT (end of transmission)', FALSE) ELSE IF ( Ch = CAN ) THEN Display_Send_Error('Receiver cancelled transmission.' , FALSE) ELSE IF ( Alt_S_Found OR Stop_Send ) THEN Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE) ELSE BEGIN GoToXY( 26 , 8 ); WRITE('EOT acknowledged, transfer complete.'); ClrEol; End_Time := TimeOfDay; R_Sector_Size := Sector_Size; IF End_Time > Start_Time THEN BEGIN Effective_Rate := ( Blocks_To_Send * R_Sector_Size ) / ( End_Time - Start_Time ); DELAY( One_Second_Delay ); GoToXY( 26 , 8 ); WRITE('Transfer rate was ',Effective_Rate:6:1,' CPS'); ClrEol; END; Writelne( ' Sent file ' + FileName, FALSE ); END; END; IF Stop_Send THEN IF Async_Carrier_Drop THEN Display_Send_Error('Carrier dropped.' , FALSE ); (* Close transferred file *) I := Close_File_Handle( XFile_Handle ); I := Int24Result; DELAY( Two_Second_Delay ); (* Remove XMODEM window *) Restore_Screen( Saved_Screen ); Reset_Global_Colors; END (* Send_Xmodem_File *);