home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GEMini Atari
/
GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso
/
files
/
bbs
/
pibterm
/
pibt3sp3
/
receivk2.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-10-04
|
32KB
|
875 lines
(*----------------------------------------------------------------------*)
(* Initialize_Receive_Display --- Set up display of Kermit reception *)
(*----------------------------------------------------------------------*)
PROCEDURE Initialize_Receive_Display;
BEGIN (* Initialize_Receive_Display *)
GoToXY( 1 , 1 );
WRITE(' Packets received :');
ClrEol;
GoToXY( 1 , 2 );
WRITE(' Bytes received :');
ClrEol;
GoToXY( 1 , 3 );
WRITE(' Retries :');
ClrEol;
GoToXY( 1 , 5 );
WRITE(' Last status message :');
ClrEol;
END (* Initialize_Receive_Display *);
(*----------------------------------------------------------------------*)
(* Kermit_Receive_Header --- get file header packet for Kermit *)
(*----------------------------------------------------------------------*)
PROCEDURE Kermit_Receive_Header;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Kermit_Receive_Header *)
(* *)
(* Purpose: Get file header packet for Kermit *)
(* *)
(* Calling Sequence: *)
(* *)
(* Kermit_Receive_Header; *)
(* *)
(* Remarks: *)
(* *)
(* This procedure receives packets and looks for the file header *)
(* packet. If a good file header packet is found, this routine *)
(* tries to open the file. If the file opens successfully, the *)
(* state changes to 'Receive_File'. If the file cannot be *)
(* opened (the file open procedure attempts to create a unique *)
(* filename if the specified file already exists) an error *)
(* packet is returned to the requesting kermit. This procedure *)
(* also handles 'Send Init' and 'Break' packets as specified in *)
(* the Kermit Protocol Manual. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Try : INTEGER;
Get_Pack : BOOLEAN;
BEGIN (* Kermit_Receive_Header *)
(* If we alerady have header, use it *)
Get_Pack := ( Kermit_Packet_Type <> Header_Pack );
REPEAT (* Get a packet *)
IF Get_Pack THEN
Receive_Packet
ELSE
Get_Pack := TRUE;
(* If recognized, perform required *)
(* function based upon packet type *)
IF Packet_OK THEN
CASE Kermit_Packet_Type OF
Header_Pack : BEGIN
(* Try opening file *)
Open_File( Write_Open,
Fix_File_Name( Rec_Packet ) );
(* If OK, then shift to receive state *)
IF Open_OK THEN
BEGIN
Buffer_Pos := 0;
Packet_Num := Rec_Packet_Num;
Display_Kermit_Message('Receiving ' +
Rec_Packet );
Send_ACK;
Kermit_State := Receive_File;
END
(* Not ok open -- send error packet *)
(* to remote Kermit. *)
ELSE
BEGIN
Packet_Buffer := 'ECannot open file';
Build_Packet;
Send_Packet;
Kermit_Abort := TRUE;
Display_Kermit_Message( 'Cannot open file: '
+ Rec_Packet );
END;
END;
Send_Pack : BEGIN
Packet_Num := Rec_Packet_Num;
Send_ACK;
END;
Break_Pack : BEGIN
Packet_Num := Rec_Packet_Num;
Send_ACK;
Receive_Done := TRUE;
Display_Kermit_Message('Completed.');
END;
End_Pack : BEGIN
Packet_Num := Rec_Packet_Num;
Send_ACK;
END;
Unknown : BEGIN
Kermit_Abort := TRUE;
Packet_Num := Rec_Packet_Num;
Packet_Buffer := 'EUnknown packet type.';
Build_Packet;
Send_Packet;
Display_Kermit_Message('Abort -- unknown packet type.');
END;
END (* CASE *)
ELSE
BEGIN
Try := Try + 1;
Packets_Bad := Packets_Bad + 1;
Send_NAK;
IF ( Try = Kermit_MaxTry ) THEN
BEGIN
Kermit_Abort := TRUE;
Packet_Num := 0;
Packet_Buffer := 'ECannot get file header.';
Build_Packet;
Send_Packet;
Display_Kermit_Message('Cannot get file header.');
END;
END;
UNTIL Kermit_Abort OR ( Kermit_State = Receive_File ) OR Receive_Done;
END (* Kermit_Receive_Header *);
(*----------------------------------------------------------------------*)
(* Kermit_Get --- Initiate server mode receive for Kermit *)
(*----------------------------------------------------------------------*)
PROCEDURE Kermit_Get;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Kermit_Get *)
(* *)
(* Purpose: Initiate server mode receive for Kermit *)
(* *)
(* Calling Sequence: *)
(* *)
(* Kermit_Get; *)
(* *)
(* Remarks: *)
(* *)
(* This procedure attempts to initiate a server receive. *)
(* First, Kermit_Get sends an 'R' packet with the selected *)
(* file name. If a valid 'Send Init' packet is received, then *)
(* the Kermit state is changed to Receive_Header. If a valid *)
(* 'Send Init' is NOT received, then an error packet is sent to *)
(* the other Kermit after the specified number of retries. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Try : INTEGER;
Init_OK : BOOLEAN;
BEGIN (* Kermit_Get *)
(* Send 'Get File' packet *)
Packet_Num := 0;
Packet_Buffer_Data := 'R' + FileName;
Build_Packet;
Try := 0;
REPEAT
Send_Packet;
Receive_Packet;
IF Packet_OK AND ( Kermit_Packet_Type = Send_Pack ) THEN
BEGIN
Packet_Num := Rec_Packet_Num;
Check_Init( Init_OK );
IF Init_OK THEN
BEGIN
Send_ACK;
Kermit_State := Receive_Header;
END;
END;
IF ( Kermit_Packet_Type = Error_Pack ) THEN
BEGIN
Display_Kermit_Message( Rec_Packet );
Kermit_Abort := TRUE;
END;
IF NOT ( Init_OK OR Kermit_Abort ) THEN
BEGIN
Packets_Bad := Packets_Bad + 1;
Try := Try + 1;
Send_NAK;
END;
IF ( ( Try = Kermit_MaxTry ) OR Kermit_Abort ) THEN
BEGIN
Kermit_Abort := TRUE;
Packet_Buffer_Data := 'ECannot get send init packet';
Build_Packet;
Send_Packet;
Display_Kermit_Message('Cannot get send_init packet.');
END;
UNTIL Kermit_Abort OR ( Kermit_State = Receive_Header );
END (* Kermit_Get *);
(*----------------------------------------------------------------------*)
(* Kermit_Receive_Init --- get Send Init packet for Kermit receives *)
(*----------------------------------------------------------------------*)
PROCEDURE Kermit_Receive_Init;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Kermit_Receive_Init *)
(* *)
(* Purpose: get 'Send Init' for Kermit receives *)
(* *)
(* Calling Sequence: *)
(* *)
(* Kermit_Receive_Init; *)
(* *)
(* Remarks: *)
(* *)
(* This procedure waits for a 'Send Init' packet; it will hang *)
(* here UNTIL a valid 'Send Init' packet is received, or an *)
(* Alt-R is entered at the keyboard to abort the transfer. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Try : INTEGER;
Init_OK : BOOLEAN;
Save_CHK: CHAR;
BEGIN (* Kermit_Receive_Init *)
(* Initialize display *)
Initialize_Receive_Display;
Try := 0;
REPEAT
(* Init packet always has block *)
(* check type one. *)
Save_CHK := His_Chk_Type;
His_Chk_Type := '1';
Receive_Packet;
His_Chk_Type := Save_CHK;
IF Packet_OK AND ( Kermit_Packet_Type = Send_Pack ) THEN
BEGIN
Packet_Num := Rec_Packet_Num;
Check_Init( Init_OK );
IF Init_OK THEN
BEGIN
Send_ACK;
Kermit_State := Receive_Header;
END
ELSE
BEGIN
Packets_Bad := Packets_Bad + 1;
Send_NAK;
Try := Try + 1;
IF ( Try = Kermit_MaxTry ) THEN
BEGIN
Kermit_Abort := TRUE;
Packet_Buffer_Data := 'ECannot get send init packet';
Build_Packet;
Send_Packet;
GoToXY(1,9);
WRITELN('Cannot get send_init packet.');
END;
END;
END;
UNTIL Kermit_Abort OR ( Kermit_State = Receive_Header );
END (* Kermit_Receive_Init *);
(*----------------------------------------------------------------------*)
(* Expand_Packet --- Expand data in Kermit packet *)
(*----------------------------------------------------------------------*)
PROCEDURE Expand_Packet;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Expand_Packet *)
(* *)
(* Purpose: Expands data in Kermit packet *)
(* *)
(* Calling Sequence: *)
(* *)
(* Expand_Packet; *)
(* *)
(*----------------------------------------------------------------------*)
VAR
InPos : INTEGER;
Q8Bit : BOOLEAN;
Temp : CHAR;
B_Temp : BYTE ABSOLUTE Temp;
BEGIN (* Expand_Packet *)
Received_Data := '';
InPos := 1;
WHILE ( InPos <= LENGTH( Rec_Packet ) ) DO
BEGIN
(* Get next character in packet *)
Temp := Rec_Packet[ InPos ];
(* Check for 8-bit quote character *)
IF ( Temp = His_Quote_8_Char ) AND Quoting THEN
BEGIN
Q8Bit := TRUE;
InPos := InPos + 1;
Temp := Rec_Packet[ InPos ];
END
ELSE
Q8Bit := FALSE;
(* Check for control quote character *)
IF ( Temp = His_Quote_Char ) THEN
BEGIN
InPos := InPos + 1;
Temp := Rec_Packet[ InPos ];
(* Convert to control character EXCEPT *)
(* for 8-bit quote character or control *)
(* quote character. *)
IF ( CHR( B_Temp AND $7F ) <> His_Quote_Char ) AND
( NOT ( Quoting AND ( Temp = His_Quote_8_Char ) ) ) THEN
B_Temp := B_Temp XOR 64;
END;
(* Turn on 8th bit if required *)
IF Q8Bit THEN
B_Temp := B_Temp OR $80;
(* Append character to result string *)
Received_Data := Received_Data + Temp;
(* Point to next character *)
InPos := InPos + 1;
END (* WHILE *);
END (* Expand_Packet *);
(*----------------------------------------------------------------------*)
(* Kermit_Receive_File --- get file data from remote Kermit *)
(*----------------------------------------------------------------------*)
PROCEDURE Kermit_Receive_File;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Kermit_Receive_File *)
(* *)
(* Purpose: Gets file data from remote Kermit *)
(* *)
(* Calling Sequence: *)
(* *)
(* Kermit_Receive_File; *)
(* *)
(* Remarks: *)
(* *)
(* This procedure receives file data from the remote Kermit *)
(* until a Break packet, and End packet, or an Unknown packet *)
(* is received. It will also abort if there are too many *)
(* retries. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Count : INTEGER;
Try : INTEGER;
(*----------------------------------------------------------------------*)
(* Handle_Data_Pack --- handle one data packet *)
(*----------------------------------------------------------------------*)
PROCEDURE Handle_Data_Pack;
VAR
Err : INTEGER;
Write_Count : INTEGER;
BEGIN (* Handle_Data_Pack *)
(* Expand data packet -- do quoting, *)
(* repeats, etc. *)
Expand_Packet;
(* Stuff data into output file buffer *)
FOR Count := 1 TO LENGTH( Received_Data ) DO
BEGIN
IF ( Buffer_Pos >= Buffer_Size ) THEN
BEGIN
Write_Count := Buffer_Size;
Err := Write_File_Handle( XFile_Handle, Write_Buffer^,
Write_Count );
Buffer_Pos := 0;
END;
Buffer_Pos := Buffer_Pos + 1;
Write_Buffer^[Buffer_Pos] := ORD( Received_Data[Count] );
END;
(* Increment received bytes count *)
Buffer_Num := Buffer_Num + LENGTH( Received_Data );
(* Acknowledge this packet *)
Send_ACK;
END (* Handle_Data_Pack *);
(*----------------------------------------------------------------------*)
(* Handle_End_Pack --- handle end of file packet *)
(*----------------------------------------------------------------------*)
PROCEDURE Handle_End_Pack;
VAR
Write_Count : INTEGER;
Err : INTEGER;
Ctrl_Z_Written: BOOLEAN;
BEGIN (* Handle_End_Pack *)
(* Write any remaining characters *)
(* in file buffer to file and *)
(* close it. *)
IF File_Open THEN
BEGIN
(* Add a Ctrl-Z to file if in *)
(* text mode to mark end of file. *)
IF ( Kermit_File_Type_Var = Kermit_Ascii ) THEN
IF ( Buffer_Pos < Buffer_Size ) THEN
BEGIN
Buffer_Pos := Buffer_Pos + 1;
Write_Buffer^[Buffer_Pos] := ORD( ^Z );
Ctrl_Z_Written := TRUE;
END
ELSE
Ctrl_Z_Written := FALSE;
(* Write any remaining characters in *)
(* buffer. *)
Write_Count := Buffer_Pos;
Err := Write_File_Handle( XFile_Handle, Write_Buffer^,
Write_Count );
(* Write a Ctrl-Z to file if in *)
(* text mode and no room in buffer. *)
IF ( Kermit_File_Type_Var = Kermit_Ascii ) AND
( NOT Ctrl_Z_Written ) THEN
BEGIN
Write_Buffer^[1] := ORD( ^Z );
Write_Count := 1;
Err := Write_File_Handle( XFile_Handle, Write_Buffer^,
Write_Count );
END;
(* Close the file *)
Err := Close_File_Handle( XFile_Handle );
(* Mark file as closed. *)
File_Open := FALSE;
END;
(* Acknowledge last record *)
Send_ACK;
(* And go back to waiting for *)
(* start of next file. *)
Kermit_State := Receive_Header;
END (* Handle_End_Pack *);
(*----------------------------------------------------------------------*)
(* Handle_Break_Packet --- Handle break packet *)
(*----------------------------------------------------------------------*)
PROCEDURE Handle_Break_Pack;
VAR
Write_Count : INTEGER;
Err : INTEGER;
Ctrl_Z_Written: BOOLEAN;
BEGIN (* Handle_Break_Pack *)
(* Write any remaining characters *)
(* in file buffer to file and *)
(* close it. *)
IF File_Open THEN
BEGIN
(* Add a Ctrl-Z to file if in *)
(* text mode to mark end of file. *)
IF ( Kermit_File_Type_Var = Kermit_Ascii ) THEN
IF ( Buffer_Pos < Buffer_Size ) THEN
BEGIN
Buffer_Pos := Buffer_Pos + 1;
Write_Buffer^[Buffer_Pos] := ORD( ^Z );
Ctrl_Z_Written := TRUE;
END
ELSE
Ctrl_Z_Written := FALSE;
(* Write any remaining characters in *)
(* buffer. *)
Write_Count := Buffer_Pos;
Err := Write_File_Handle( XFile_Handle, Write_Buffer^,
Write_Count );
(* Write a Ctrl-Z to file if in *)
(* text mode and no room in buffer. *)
IF ( Kermit_File_Type_Var = Kermit_Ascii ) AND
( NOT Ctrl_Z_Written ) THEN
BEGIN
Write_Buffer^[1] := ORD( ^Z );
Write_Count := 1;
Err := Write_File_Handle( XFile_Handle, Write_Buffer^,
Write_Count );
END;
(* Close the file *)
Err := Close_File_Handle( XFile_Handle );
(* Mark file as closed. *)
File_Open := FALSE;
END;
(* Acknowledge this packet *)
Send_ACK;
(* We're done with this batch of files. *)
Receive_Done := TRUE;
END (* Handle_Break_Pack *);
(*----------------------------------------------------------------------*)
BEGIN (* Kermit_Receive_File *)
(* Loop over packets in file being *)
(* received. *)
REPEAT
(* Get next packet *)
Receive_Packet;
(* Number of tries this packet *)
Try := 0;
CASE Packet_OK OF
(* If packet bad *)
FALSE : BEGIN
Try := Try + 1;
IF ( Try = Kermit_MaxTry ) THEN
BEGIN
Kermit_Abort := TRUE;
Packet_Buffer := 'EToo many retries.';
Build_Packet;
Send_Packet;
END
ELSE
Send_NAK;
END;
(* If packet OK *)
TRUE : BEGIN
IF ( Packet_Num = Rec_Packet_Num ) THEN
Send_ACK
ELSE
BEGIN
Packet_Num := Rec_Packet_Num;
CASE Kermit_Packet_Type OF
Data_Pack : Handle_Data_Pack;
End_Pack : Handle_End_Pack;
Break_Pack : Handle_Break_Pack;
Header_Pack: ;
Unknown : Send_NAK;
ELSE
Kermit_Abort := TRUE;
END (* CASE *);
END;
END;
END (* CASE *);
UNTIL ( Kermit_Abort OR Receive_Done OR
( Kermit_Packet_Type = Header_Pack ) );
END (* Kermit_Receive_File *);
(*----------------------------------------------------------------------*)
PROCEDURE Do_Kermit_Receive;
BEGIN (* Do_Kermit_Receive *)
(* Open display window for transfer *)
Save_Screen( Local_Save );
IF FileName <> '' THEN
Menu_Title := 'Receive file ' + FileName + ' using Kermit'
ELSE
Menu_Title := 'Receive file using Kermit';
Draw_Menu_Frame( 15, 10, 78, 21, Menu_Frame_Color,
Menu_Text_Color, Menu_Title );
Window( 16, 11, 77, 20 );
(* 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;
(* Initialize status display information *)
Packets_Received := 0;
Packets_Sent := 0;
Packets_Bad := 0;
Buffer_Num := 0.0;
Receive_Done := FALSE;
Kermit_MaxTry := 5;
Kermit_Abort := FALSE;
Kermit_Retry := FALSE;
Buffer_Size := Buffer_Length;
Quoting := FALSE;
(* Initialize status display *)
Initialize_Receive_Display;
(* Choose reception method depending upon *)
(* whether remote system in server mode *)
(* or not. *)
IF Kermit_Remote_Server THEN
Kermit_State := Get_File
ELSE
Kermit_State := Receive_Init;
(* Loop over received packets *)
REPEAT
(* Take action depending upon current *)
(* Kermit state. *)
CASE Kermit_State OF
Get_File : Kermit_Get;
Receive_Init : Kermit_Receive_Init;
Receive_Header : Kermit_Receive_Header;
Receive_File : Kermit_Receive_File;
END (* CASE *);
UNTIL ( Kermit_Abort OR Receive_Done );
IF Receive_Done THEN
Display_Kermit_Message('Completed.');
DELAY( Two_Second_Delay );
(* Remove download buffer *)
IF Long_Buffer THEN
FREEMEM( Write_Buffer , Buffer_Length );
(* Remove Kermit window *)
Restore_Screen( Local_Save );
Reset_Global_Colors;
END (* Do_Kermit_Receive *);
(*----------------------------------------------------------------------*)
PROCEDURE Get_File_Pattern;
BEGIN (* Get_File_Pattern *)
GoToXY( 2 , 8 );
WRITE('File to receive: ');
IF ( NOT Host_Mode ) THEN
READLN( FileName )
ELSE
WRITELN( FileName );
END (* Get_File_Pattern *);
(*----------------------------------------------------------------------*)
BEGIN (* Receive_Kermit_File *)
(* Save screen *)
Save_Screen( Local_Save_2 );
(* Get Kermit menu *)
WITH Kermit_Menu DO
BEGIN
Menu_Size := 6;
Menu_Default := 1;
Menu_Row := 11;
Menu_Column := 20;
Menu_Tcolor := Menu_Text_Color;
Menu_Bcolor := BackGround_Color;
Menu_Fcolor := Menu_Frame_Color;
Menu_Width := 40;
Menu_Height := 10;
END (* WITH Kermit_Menu *);
FOR I := 1 TO 6 DO
WITH Kermit_Menu.Menu_Entries[I] DO
BEGIN
Menu_Item_Row := I;
Menu_Item_Column := 2;
CASE I OF
1: Menu_Item_Text := 'a) GET Text File';
2: Menu_Item_Text := 'b) GET Binary File';
3: Menu_Item_Text := 'c) RECEIVE Text File';
4: Menu_Item_Text := 'd) RECEIVE Binary File';
5: Menu_Item_Text := 'L) Logout Remote Server';
6: Menu_Item_Text := 'Q) Quit Kermit';
END (* CASE *);
END;
Kermit_Menu.Menu_Title := 'Choose Kermit function: ';
Kermit_Done := FALSE;
Sending_File := FALSE;
Host_Count := 0;
REPEAT
(* Reinitialize Kermit variables *)
Kermit_Init;
(* Display Kermit receive menu *)
IF ( NOT Host_Mode ) THEN
BEGIN
Menu_Display_Choices( Kermit_Menu );
Menu_Choice := Menu_Get_Choice( Kermit_Menu , Dont_Erase_Menu );
END
ELSE
BEGIN
Host_Count := Host_Count + 1;
IF ( Host_Count = 1 ) THEN
IF Kermit_File_Type_Var <> Kermit_Binary THEN
Menu_Choice := 3
ELSE
Menu_Choice := 4
ELSE
Menu_Choice := 6;
END;
(* Perform desired Kermit function *)
CASE Menu_Choice OF
1: BEGIN
Kermit_File_Type_Var := Kermit_Ascii;
Get_File_Pattern;
Kermit_Remote_Server := TRUE;
IF ( LENGTH( FileName ) > 0 ) THEN
Do_Kermit_Receive;
END;
2: BEGIN
Kermit_File_Type_Var := Kermit_Binary;
Get_File_Pattern;
Kermit_Remote_Server := TRUE;
IF ( LENGTH( FileName ) > 0 ) THEN
Do_Kermit_Receive;
END;
3: BEGIN
Kermit_File_Type_Var := Kermit_Ascii;
FileName := '';
Kermit_Remote_Server := FALSE;
Do_Kermit_Receive;
END;
4: BEGIN
Kermit_File_Type_Var := Kermit_Binary;
FileName := '';
Kermit_Remote_Server := FALSE;
Do_Kermit_Receive;
END;
5: Kermit_Finish_Server;
6: Kermit_Done := TRUE;
END (* CASE *);
UNTIL Kermit_Done;
Restore_Screen( Local_Save_2 );
Reset_Global_Colors;
END (* Receive_Kermit_File *);
ə
