(*----------------------------------------------------------------------*) (* Send_Ymodem_File --- Uploads file with Ymodem *) (*----------------------------------------------------------------------*) PROCEDURE Send_Ymodem_File; (*----------------------------------------------------------------------*) (* *) (* Procedure: Send_Ymodem_File *) (* *) (* Purpose: Uploads files using Ymodem *) (* *) (* Calling Sequence: *) (* *) (* Send_Ymodem_File; *) (* *) (* Calls: KeyPressed *) (* Async_Send *) (* Async_Receive_With_TimeOut *) (* Check_KeyBoard *) (* RvsVideoOn *) (* RvsVideoOff *) (* Wait_For_Nak *) (* Perform_Upload *) (* *) (* Remarks: *) (* *) (* This routine performs wildcard directory searches and *) (* implements the Ymodem batch file transfer protocol. *) (* *) (* Note that the header constructed here contains the *) (* file name, file size, and file creation time. *) (* *) (*----------------------------------------------------------------------*) VAR File_Pattern : AnyStr; SFileName : PACKED ARRAY[1..11] OF CHAR; Int_Ch : INTEGER; Ch : CHAR; CheckSum : INTEGER; EndFName : BOOLEAN; I : INTEGER; J : INTEGER; Local_Save : Saved_Screen_Ptr; File_Entry : Directory_Record; Ack_OK : BOOLEAN; Use_CRC : BOOLEAN; OK_File : BOOLEAN; (*----------------------------------------------------------------------*) (* Check_KeyBoard --- Check for keyboard input *) (*----------------------------------------------------------------------*) PROCEDURE Check_KeyBoard; BEGIN (* Check_KeyBoard *) (* If Alt_R found, stop transfer *) IF KeyPressed THEN BEGIN READ( Kbd, Ch ); IF ( Ch = CHR( ESC ) ) AND KeyPressed THEN BEGIN READ( Kbd, Ch ); IF ORD( Ch ) = Alt_S THEN BEGIN Stop_Send := TRUE; WRITELN(' Alt_S accepted, transfer cancelled.'); END; END; END; END (* Check_KeyBoard *); (*----------------------------------------------------------------------*) (* Make_Ymodem_Header --- Send special YMODEM header block *) (*----------------------------------------------------------------------*) PROCEDURE Make_Ymodem_Header; (*----------------------------------------------------------------------*) (* *) (* Procedure: Make_Ymodem_Header *) (* *) (* Purpose: Makes special Ymodem header block *) (* *) (* Calling sequence: *) (* *) (* Make_Ymodem_Header; *) (* *) (* Calls: None *) (* *) (* Remarks: *) (* *) (* This version of PibTerm DOES send the file creation time. *) (* *) (* Format of Ymodem block: *) (* *) (* Bytes Contents *) (* ----- --------------------------------------- *) (* *) (* 1 SOH *) (* 2 0 *) (* 3 255 *) (* 4-j File name in lower case *) (* j+1-k File size in bytes *) (* k+1-l File creation time/date in Unix format *) (* 132-133 CRC of block *) (* *) (* The first three bytes are added later by the Xmodem send *) (* routine. *) (* *) (*----------------------------------------------------------------------*) VAR I : INTEGER; J : INTEGER; K : INTEGER; L : INTEGER; CRC : INTEGER; ACK_Ok : BOOLEAN; Int_Ch : INTEGER; Fs1 : REAL; Fs2 : REAL; S_File_Size : REAL; C_File_Size : STRING[10]; OK_File : BOOLEAN; Year : INTEGER; Month : INTEGER; Day : INTEGER; Hour : INTEGER; Mins : INTEGER; Secs : INTEGER; Date : REAL; OctD : STRING[20]; RemO : REAL; Quot : REAL; (*----------------------------------------------------------------------*) (* LowerCase --- convert character to lower case *) (*----------------------------------------------------------------------*) FUNCTION LowerCase( C: CHAR ): CHAR; BEGIN (* LowerCase *) IF ( C IN ['A'..'Z'] ) THEN LowerCase := CHR( ORD( C ) - 32 ) ELSE LowerCase := C; END (* LowerCase *); (*----------------------------------------------------------------------*) PROCEDURE Set_Ymodem_Date( VAR Date : REAL; Year : INTEGER; Month : INTEGER; Day : INTEGER; Hour : INTEGER; Mins : INTEGER; 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; Leap_Year : BOOLEAN; (* 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 *) Date := GMT_Difference * Secs_Per_Hour; FOR I := 1970 TO ( Year - 1 ) DO BEGIN IF ( I MOD 4 ) = 0 THEN T := Secs_Per_Leap_Year ELSE T := Secs_Per_Year; Date := Date + T; END; IF ( Year MOD 4 ) = 0 THEN Days_Per_Month[2] := 29 ELSE Days_Per_Month[2] := 28; FOR I := 1 TO ( Month - 1 ) DO Date := Date + Days_Per_Month[I] * Secs_Per_Day; Date := Date + ( Day - 1 ) * Secs_Per_Day + Hour * Secs_Per_Hour + Mins * Secs_Per_Minute + Secs; END (* Get_Ymodem_Date *); (*----------------------------------------------------------------------*) BEGIN (* Make_Ymodem_Header *) (* Zero out block *) FOR I := 1 TO 130 DO Sector_Data[I] := 0; (* File name *) L := LENGTH( FileName ); FOR I := 1 TO L DO Sector_Data[I] := ORD( LowerCase(FileName[I]) ); (* File size in Ascii *) Fs1 := File_Entry.File_Size[1]; Fs2 := File_Entry.File_Size[2]; IF Fs1 < 0 Then Fs1 := Fs1 + 65536.0; IF Fs2 < 0 Then Fs2 := Fs2 + 65536.0; S_File_Size := Fs2 * 65536.0 + Fs1; STR( S_File_Size:10:0, C_File_Size ); J := 1; WHILE( C_File_Size[J] = ' ' ) DO J := J + 1; (* Insert file size in block *) Sector_Data[L + 1] := ORD(' '); I := L + 2; FOR K := J TO 10 DO BEGIN Sector_Data[I] := ORD( C_File_Size[K] ); I := I + 1; END; (* Get file date and time *) WITH File_Entry DO BEGIN Hour := ( File_Time SHR 11 ) AND $1F; Mins := ( File_Time AND $07E0 ) SHR 5; Secs := ( File_Time AND $001F ) * 2; Year := 1980 + ( ( File_Date SHR 9 ) AND $7F ); Month := ( File_Date AND $01E0 ) SHR 5; Day := File_Date AND $001F; END; (* Convert DOS time and date to *) (* number of seconds since *) (* January 1, 1970. *) Set_Ymodem_Date( Date, Year, Month, Day, Hour, Mins, Secs ); (* Convert date to octal string *) OctD := ''; REPEAT Quot := INT( Date / 8.0 ); Remo := Date - 8.0 * Quot; OctD := CHR( TRUNC( Remo ) + ORD( '0' ) ) + OctD; Date := Quot; UNTIL( Date <= 0.0 ); (* Insert octal date into Ymodem block *) Sector_Data[I] := ORD(' '); FOR K := 1 TO LENGTH( OctD ) DO BEGIN I := I + 1; Sector_Data[I] := ORD(OctD[K]); END; (* Compute CRC *) Crc := 0; FOR I := 1 TO 128 DO Crc := Update_Crc( Crc , Sector_Data[I] ); Sector_Data[129] := HI( Crc ); Sector_Data[130] := LO( Crc ); END (* Make_Ymodem_Header *); (*----------------------------------------------------------------------*) (* Get_Ymodem_File_Name --- get file name for upload *) (*----------------------------------------------------------------------*) PROCEDURE Get_Ymodem_File_Name( VAR OK_File : BOOLEAN ); VAR I : INTEGER; BEGIN (* Get_Ymodem_File_Name *) FileName := ''; I := 1; WHILE( File_Entry.File_Name[I] <> CHR( 0 ) ) DO BEGIN FileName := FileName + File_Entry.File_Name[I]; I := I + 1; END; OK_File := ( File_Entry.File_Attr AND ( Dir_Attr_Volume_Label + Dir_Attr_Subdirectory ) = 0 ); (* If host mode, make sure file *) (* is on xferlist! *) IF Host_Mode THEN OK_File := Scan_Xfer_List( FileName ); END (* Get_Ymodem_File_Name *); (*----------------------------------------------------------------------*) (* Perform_Upload --- Do the upload *) (*----------------------------------------------------------------------*) PROCEDURE Perform_Upload; BEGIN (* Perform_Upload *) Writelne(' Uploading: ' + FileName , TRUE ); Send_Xmodem_File( TRUE ); TextColor( Menu_Text_Color ); END (* Perform_Upload *); (*----------------------------------------------------------------------*) (* Send_Null_File_Name --- Send null file name to stop batch transfer *) (*----------------------------------------------------------------------*) PROCEDURE Send_Null_File_Name; BEGIN (* Send_Null_File_Name *) (* Purge reception *) REPEAT Async_Receive_With_Timeout( One_Second , Int_Ch ); UNTIL ( Int_Ch = TimeOut ); (* Send null file name block 0 *) Async_Send( CHR( SOH ) ); Async_Send( CHR( 0 ) ); Async_Send( CHR( 255 ) ); FOR I := 1 TO 130 DO Async_Send( CHR( 0 ) ); WRITELN(' '); WRITELN(' Sending null file name to terminate batch transfer ...'); (* Wait for ACK *) Async_Receive_With_TimeOut( Ten_Seconds , Int_Ch ); IF ( Int_Ch = ACK ) THEN BEGIN Writelne(' ', TRUE); Writelne(' Host system ACKnowledged end of batch.', TRUE); END; END (* Send_Null_File_Name *); (*----------------------------------------------------------------------*) BEGIN (* Send_Ymodem_File *) (* Open display window for transfers *) Save_Screen( Local_Save ); Draw_Menu_Frame( 2, 2, 79, 24, Menu_Frame_Color, Menu_Text_Color, 'Batch file upload using Ymodem' ); Writelne( 'Batch file upload using Ymodem' , FALSE ); Window( 3, 3, 78, 23 ); (* Get file name pattern to send *) File_Pattern := FileName; (* See if we can find anything to *) (* be sent. *) Stop_Send := ( Dir_Find_First_File( File_Pattern, File_Entry ) <> 0 ); IF Stop_Send THEN Writelne(' No files found to send.' , TRUE ); (* Loop over file names *) WHILE( NOT Stop_Send ) DO BEGIN (* Get file name *) Get_Ymodem_File_Name( OK_File ); (* Get Ymodem header block *) IF OK_File THEN BEGIN IF NOT Stop_Send THEN Make_Ymodem_Header; (* Send the file itself *) IF NOT Stop_Send THEN Perform_Upload; END; (* See if more files to transfer *) Stop_Send := Stop_Send OR ( Dir_Find_Next_File( File_Entry ) <> 0 ); END (* While *); (* Send null file name to indicate *) (* no more files *) Send_Null_File_Name; (* Indicate end of transfer *) Writelne(' ', TRUE); RvsVideoOn ( Menu_Text_Color, BackGround_Color ); Writelne(' Ymodem batch transfer complete.', TRUE); RvsVideoOff( Menu_Text_Color, BackGround_COlor ); DELAY( Two_Second_Delay ); (* Remove batch transfer window *) Restore_Screen( Local_Save ); Reset_Global_Colors; END (* Send_Ymodem_File *);