home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
c
/
qk3sar.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
30KB
|
725 lines
Unit SendRecv ;
Interface
Uses Dos,Crt,Printer, (* Standard Turbo Pascal Units *)
KGlobals,
ModemPro,
Packets ;
(* Global procedures *)
PROCEDURE SENDFILE (var InParms : String);
PROCEDURE BreakACK (Achar : Char);
PROCEDURE RECVFILE (var InParms : String);
Implementation
(* **************************************************************** *)
(* SENDFILE - This routine handles the sending of a file from * *)
(* the micro computer. * *)
(* **************************************************************** *)
PROCEDURE SENDFILE (var InParms : String);
VAR
SENDING, GETREPLY, LastFile, rawfile : Boolean ;
abyte, Kchar,Kbchar : byte ;
DiskDrive : String [2] ;
MyFiles : string ;
FileName,AsFileNames,AsFileName,
Atoken,Tempname : string ;
FileInfo : SearchRec ;
achar,prevchar : char ;
ErrorMsg : String[80];
IOerror : Integer ;
PacketCount,i,ix,MaxOutData,RepCount,MarkOutCount : Integer ;
Fsize,BytesSent : longint ;
FileBuffer : array [1..Buffersize] of char ;
FileToSend : text ;
Label subdir,subdir1,GetAsName,GetNextFile,Quoting,Exit ;
(* --------------------------------------------------- *)
(* SENDRAW - This routine send the file in unpacket *)
(* mode, Simply read and send. *)
(* --------------------------------------------------- *)
Procedure SENDRAW ;
Begin (* SendRaw Procedure *)
Sending := true ;
While Sending Do
Begin (* Send a file *)
ClrScr; Writeln(' Sending File >>>>>>> ',Filename,' <<<<<<< ');
Assign(FileToSend,FileName);
SetTextBuf(FileToSend,FileBuffer);
RESET(FileToSend) ;
While not Eof(FileToSend) do
Begin (* Send data *)
Read(FileToSend,Achar);
SendChar(ord(achar));
If LocalEcho then Write(achar)
else If Readchar(abyte) then Write(chr(abyte));
If XonXoff and (abyte = $0D) then (* wait for Xon *)
While abyte<>XON do
If Readchar(abyte) then
else abyte := xon ;
End ; (* Send data *)
(*$I- *) CLOSE(FileToSend); (*$I+ *)
IOerror := IOResult ;
If (IOerror <> 0) and (IOerror<>103) then
writeln('Close Error ',IOerror);
(* Sending := Nextfile(Myfiles,Filename,FileInfo); *)
End ; (* Send a file *)
Writeln(' ');
End ; (* SendRaw Procedure *)
(* **************************************************************** *)
BEGIN (* SENDFILE procedure *)
rawfile := false ;
RetryCount := 0 ;
(* Check the file to be sent here *)
If length(InParms) < 1 then
Begin (* Get name of file to send *)
Write (' Enter name of file to be sent >');
Readln(InParms);
End;
MyFiles := ' ';
MyFiles := UpperCase(GetToken(InParms));
AsFileNames := MyFiles ;
ix := Pos(':',AsFilenames) ;
If ix > 1 then delete(AsFilenames,1,ix) ; (* Eliminate disk prefix *)
subdir1:
ix := Pos('\',AsFileNames) ;
If ix > 0 then delete(AsFileNames,1,ix) ; (* Eliminate sub-dir prefixs *)
if ix > 0 then goto subdir1 ;
(* if As name not specified assume same name without disk specification *)
Atoken := UpperCase(GetToken(InParms));
If Atoken = 'AS' then
If length(InParms)<1 then AsFileNames := MyFiles
else AsFileNames := UpperCase(GetToken(InParms))
else
If Atoken = 'RAW' then rawfile := true
else InParms := Atoken + InParms ;
subdir:
ix := Pos('\',AsFilenames) ;
If ix > 1 then delete(AsFilenames,1,ix) ; (* Eliminate sub-dir prefixs *)
if ix > 1 then goto subdir ;
ix := Pos(':',Myfiles) ;
If ix = 2 then diskdrive := copy(Myfiles,1,2)
else diskdrive := '';
FindFirst(Myfiles,Anyfile,FileInfo) ;
If DosError = 0 then filename := FileInfo.name
else
begin (* No file found *)
Writeln (' File "',MyFiles,'" not found.');
Goto Exit ;
end ; (* No file found *)
AsFilename := 'Blank' ;
If rawfile then
begin SendRaw ; goto exit ; end ;
GetAsName:
If NewAsFile(Myfiles,Filename,AsFileNames,AsFileName) then
else
begin (* get next file *)
FindNext(Fileinfo) ;
filename := FileInfo.name ;
fsize := FileInfo.size ;
If DosError = 0 then goto GetAsName
else
begin (* No file found *)
Writeln (' File "',MyFiles,'" not found on disk.');
Goto Exit ;
end ; (* No file found *)
end ; (* get next file *)
STATE := S ;
BreakState := NoBreak ;
GETREPLY := FALSE ;
LastFile := false ;
SENDING := TRUE ;
ClrScr;
GotoXY(10,4); Write(' Number of Packets Sent = ');
GotoXY(10,5); Write(' Number of Retries = ');
PacketCount := 0 ;
WHILE SENDING DO
BEGIN (* Send files *)
IF GETREPLY THEN
Begin (* Getreply *)
IF RECVPACKET THEN
Begin (* got packet *)
If INSEQ <> OUTSEQ Then
If RECVPACKET THEN
ELSE RESENDIT(10) ;
IF InPacketType = Ord('Y') THEN
ELSE
IF InPacketType = Ord('N') THEN RESENDIT(10)
ELSE
IF InPacketType = Ord('R') THEN STATE := S
ELSE
IF INPACKETTYPE = Ord('E') THEN
Begin (* Error Packet *)
Writeln(' ') ; Write(' Error Packet >>>> ') ;
For I:=1 to InDataCount Do
Write(Chr(RecvData[i])) ;
STATE := A ; (* ABORT if not INIT packet *)
Writeln('');
End (* Error Packet *)
ELSE STATE := A
End (* got packet *)
ELSE RESENDIT(10) ;
If (InPacketType = Ord('Y')) and (InDataCount > 1) then
If RecvData[1] = Ord('X') then STATE := SZ else
If RecvData[1] = Ord('Z') then
Begin STATE := SZ ; LastFile := true ; End ;
If STATE = SD then
Case Breakstate of
NoBreak : ;
BC : Sending := False ;
BE : STATE := A ;
BX : STATE := SZ ;
BZ : Begin STATE := SZ ; LastFile := true ; End ;
End ; (* Case Breakstate *)
End ; (* GetReply *)
GotoXY(36,5); Write (RetryCount);
GETREPLY := TRUE ;
CASE STATE OF
S : BEGIN (* Send INIT packit *)
OutPacketType := Ord('S') ;
PutInitPacket ;
SENDPACKET ;
STATE := SF ;
END ; (* Send INIT packit *)
SF: BEGIN (* Send file header *)
If OutPacketType = Ord('S') then GetInitPacket ;
OUTSEQ := OUTSEQ + 1 ;
IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
OutPacketType := Ord('F') ;
TempName := Prefixof(AsFileNames) + AsFileName ;
OutDataCount := LENGTH(TempName) ;
For i := 1 to OutDataCount do SendData[i] := Ord(Tempname[i]) ;
GotoXY(10,2);
Write(' Sending file ',Filename,' as ',TempName,
' ');
Assign(FileToSend,Prefixof(MyFiles)+FileName);
SetTextBuf(FileToSend,FileBuffer);
RESET(FileToSend);
FSize := FileInfo.Size;
BytesSent := 0 ;
GotoXY(10,6) ;
Write(' File size ',FSize,' Bytes' );
GotoXY(10,7); Write(' Amount Transmitted = ');
STATE := SD ;
SENDPACKET ;
END ; (* Send file header *)
SD: BEGIN (* Send data *)
OutDataCount := 0 ;
MarkOutCount := 1 ;
RepCount := 0 ;
OUTSEQ := OUTSEQ + 1 ;
IF OUTSEQ >= 64 THEN OUTSEQ := 0 ;
OutPacketType := Ord('D') ;
MaxOutData := rPacketSize-3-4 ;
If rPacketSize > 94 then MaxOutData := MaxOutData - 3 ;
WHILE (OutDataCount<MaxOutData) AND (BytesSent<FSize) DO
BEGIN (* Read a char *)
OutDataCount := OutDataCount + 1 ;
Read(FileToSend,Achar);
BytesSent := BytesSent + 1 ;
SendData[OutDataCount] := ord(achar);
If (prevchar = achar) and (RepChar > $20) and (BytesSent<FSize)
and (RepCount < 92) and (OutDataCount > 1) then
Begin (* repeated character *)
RepCount := RepCount + 1 ;
If RepCount = 1 then goto Quoting
else OutDataCount := OutDataCount - 1 ;
End (* repeated character *)
else
Begin (* different char *)
If RepCount > 1 then
Begin (* add repeat count prefix *)
OutDataCount := MarkOutCount ;
SendData[OutDataCount] := RepChar ;
SendData[OutDataCount+1] := RepCount + 1 + $20 ;
SendData[OutDataCount+2] := ord(prevchar) ;
OutDataCount := OutDataCount + 2 ;
End ; (* add repeat count prefix *)
Prevchar := achar ;
MarkOutCount := OutdataCount ;
If RepCount = 1 then RepCount := 0 ;
Quoting :
IF SendData[OutDataCount] >= $80 THEN
IF Bit8Quote = $20 THEN (* No bit8 quoting *)
(* Just drop the 8th bit *)
SendData[OutDataCount] := SendData[OutDataCount] -$80
ELSE
BEGIN (* BIT8 QUOTING *)
SendData[OutDataCount+1] := SendData[OutDataCount]-$80;
SendData[OutDataCount] := Bit8Quote ;
OutDataCount := OutDataCount + 1 ;
END ; (* BIT8 QUOTING *)
IF SendData[OutDataCount] < $20 THEN
BEGIN (* CONTROL QUOTING *)
SendData[OutDataCount+1] := SendData[OutDataCount] +$40;
SendData[OutDataCount] := sCntrlQuote ;
OutDataCount := OutDataCount + 1 ;
END ; (* CONTROL QUOTING *)
IF SendData[OutDataCount] = $7F THEN
BEGIN (* DEL QUOTING *)
SendData[OutDataCount+1] := $3F ;
SendData[OutDataCount] := sCntrlQuote ;
OutDataCount := OutDataCount + 1 ;
END ; (* DEL QUOTING *)
IF (SendData[OutDataCount] = sCntrlQuote) OR
( (Bit8Quote > $20) and
(SendData[OutDataCount] = Bit8Quote)) OR
( (RepChar > $20) and
(SendData[OutDataCount] = RepChar)) THEN
BEGIN (* Quote the quote *)
SendData[OutDataCount+1] := SendData[OutDataCount] ;
SendData[OutDataCount] := sCntrlQuote ;
OutDataCount := OutDataCount + 1 ;
END ; (* Quote the quote *)
If RepCount > 1 then
begin (* reset Repeat count *)
RepCount := 0 ;
OutDataCount := OutDataCount + 1 ;
SendData[OutDataCount] := ord(achar) ;
MarkOutCount := OutDataCount ;
Goto Quoting ;
end ; (* reset Repeat count *)
End ; (* different char *)
END ; (* Read a char *)
PacketCount := PacketCount + 1 ;
GotoXY(36,4) ; WRITE (PacketCount);
GotoXY(36,7) ; WRITE ( Round((BytesSent/Fsize) * 100),' % ');
IF BytesSent>=FSize THEN STATE := SZ ;
SENDPACKET ;
END ; (* Send data *)
SZ: BEGIN (* End of File *)
(*$I- *) Close(FILETOSEND); (*$I+ *)
IOerror := IOResult ;
If (IOerror <> 0) and (IOerror <> 103) then
writeln('Error File Close -',IOerror);
GotoXY(10,8) ;
If BreakState = NoBreak then
WRITELN ('File ',Filename,' has been sent as ',AsFileName,
' ')
else
Writeln('File ',Filename,' Partially sent as ',AsFileName,
' ');
If Lastfile then STATE := SB
else
GetNextFile:
Begin (* Get next file *)
FindNext(FileInfo) ;
filename := FileInfo.name ;
If DosError = 0 then
If NewAsFile(Myfiles,Filename,AsFilenames,AsFilename)
then STATE := SF
else goto GetNextFile
else STATE := SB ;
End ; (* Get next file *)
If Breakstate = BX then Breakstate := NoBreak ;
SendPacketType('Z') ;
END ; (* End of File *)
SB: BEGIN (* Last file sent *)
(* WRITELN ('SENT last file completed'); *)
SendPacketType('B') ;
STATE := C ;
END ; (* Last file sent *)
C: BEGIN (* Completed Sending *)
GotoXY(10,9) ;
If BreakState = NoBreak then
WRITELN ('Sending FILEs completed OK ')
else
WRITELN ('Sending FILEs terminated due to manual Interruption ');
SENDING := FALSE ;
END ; (* Completed Sending *)
A: BEGIN (* Abort Sending *)
(*$I- *) Close(FILETOSEND); (*$I+ *)
IOError := IOResult ;
If (IOerror <> 0) and (IOerror <> 103) then
writeln(' Error closing file - ',IOerror);
GotoXY(10,9) ;
WRITELN ('SENDing files ABORTED');
ABORT := BADSF ;
SENDING := FALSE ;
(* SEND ERROR packet *)
OutDataCount := 15 ;
OUTSEQ := 0 ;
ErrorMsg := 'Send file abort' ;
for i := 1 to OutDataCount do SendData[i] := Ord(ErrorMsg[i]) ;
OutPacketType := Ord('E');
SENDPACKET ;
END ; (* Abort Sending *)
END ; (* CASE of STATE *)
END ; (* Send files *)
Exit:
END ; (* SENDFILE procedure *)
(* ------------------------------------------------------------ *)
(* BreakACK - Procedure will send a ACK plus a break char *)
(* X or Z . *)
(* ------------------------------------------------------------ *)
PROCEDURE BreakACK (Achar : Char);
BEGIN (* SEND ACK or NAK *)
OutDataCount := 1 ;
OUTSEQ := OUTSEQ + 1 ;
IF OUTSEQ >= 64 then OUTSEQ := 0;
OUTPACKETTYPE := ord('Y');
SendData[1] := Ord(Achar);
SENDPACKET ;
END ; (* SEND ACK or NAK *)
(* ------------------------------------------------------------ *)
(* RenameDup- Procedure will check to see if a file is *)
(* already present if it is it returns a new *)
(* name modified with &. *)
(* Note : this procedure is maybe called recursively. *)
(* ------------------------------------------------------------ *)
PROCEDURE RenameDup(var MyFile:String);
var FileInfo : SearchRec ;
BEGIN (* RenameDup *)
FindFirst(MyFile,AnyFile,FileInfo) ;
If DosError = 0 then
Begin (* change name of file *)
Insert ('&',Myfile,Pos('.',Myfile));
if Pos('.',Myfile) > 9 then
Delete(Myfile,Pos('&',Myfile)-1,1);
RenameDup(Myfile);
End ; (* change name of file *)
END ; (* RenameDup *)
(* **************************************************************** *)
(* RECVFILE - This routine handles the Receiving of a file from *)
(* the Main frame computer. *)
(* *)
(* **************************************************************** *)
PROCEDURE RECVFILE (var InParms : string);
CONST buffersize = 1280 ; (* must be a multiple of 128 *)
VAR
Receiving,ReplaceFile : BOOLEAN ;
Bit8 : BYTE ;
Lastseqnum,Retries,i,j,
ByteCount : LONGINT ;
PacketCount,CharCount : INTEGER ;
Filenames,FileName,
Myfiles,Myfile,Astring,
ErrorMsg : String ;
FileComing : Text ;
FileBuffer : packed array [1..buffersize] of char ;
Label Gotinit;
(* ------------------------------------------------------------ *)
(* SENDNAK - Procedure of RECVFILE, will check the number of *)
(* RETRIES , if it is greater than 0 it will send a *)
(* call SendPacketType('N') which send a NAK packet *)
(* and decrements the RETRIES by 1. *)
(* Side Effect - RETRIES is decremented by 1. *)
(* STATE is set to A if no more retries. *)
(* - RetryCount is incremented *)
(* ------------------------------------------------------------ *)
PROCEDURE SENDNAK ;
BEGIN (* SEND NAK *)
RetryCount := RetryCount + 1;
IF RETRIES > 0 then
BEGIN (* Ask for a retransmission *)
SendPacketType('N');
OUTSEQ := OUTSEQ - 1 ;
RETRIES := RETRIES - 1 ;
END (* Ask for a retransmission *)
else
BEGIN (* lack of Nak *)
STATE := A ;
Writeln(' Last of NAK. No more Retries ');
END ; (* lack of Nak *)
END ; (* SEND NAK *)
BEGIN (* ------- RECVFILE procedure ------- *)
WRITELN (' RECEIVE file command . ',InParms);
Packetcount := 0 ;
ReplaceFile := false ;
Lastseqnum := 0 ;
(* Scan Parameter string *)
FileNames := GETTOKEN(InParms);
j:=Pos(':',FileNames);
if j = 0 then MyFiles := FileNames
else MyFiles := Copy(FileNames,j+1,Length(FileNames)-j);
Astring := Uppercase(GetToken(Inparms));
If Astring = 'AS' then
if length(InParms) > 0 then
Begin (* get AS name *)
MyFiles := GetToken(Inparms);
Astring := Uppercase(GetToken(Inparms));
If Pos(Astring,' REPLACE') = 2 then ReplaceFile := True
else InParms := Astring + InParms;
End (* get AS name *)
else MyFiles := FileNames
else
If Pos(Astring,' REPLACE') = 2 then ReplaceFile := True
else InParms := Astring + InParms ;
If FileNames <> '' then
Begin (* Send a R type packet requesting the file *)
writeln('Filenames=',Filenames,' length =',length(Filenames));
OutDataCount := length(Filenames);
OutSeq := 0 ;
OutPacketType := ord('R');
For i := 1 to length(Filenames) do
SendData[i] := Ord(FileNames[i]) ;
WaitXon := false ;
SendPacket ;
End (* Send a R type packet requesting the file *)
else
WaitXon := XonXoff ;
STATE := R ;
RECEIVING := TRUE ;
BreakState := NoBreak ;
RETRIES := 10 ; (* Up to 10 retries allowed. *)
RetryCount := 0 ;
clrscr ;
GotoXY(10,4) ;
Write('Number of Data Packets Received = ');
GotoXY(10,5) ;
Write('Number of Nak responses sent = ');
GotoXY(10,6) ;
Write('Number of Bytes received = ');
WHILE RECEIVING DO CASE STATE OF
(* R ------ Initial receive State ------- *)
(* Valid received msg type : S *)
R : BEGIN (* Initial Receive State *)
If InPacketType =Ord('S') then goto Gotinit;
IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then SENDNAK
else
Gotinit:
(* Get a packet *)
IF INPACKETTYPE = Ord('S') then
BEGIN (* Got INIT packet *)
GetInitPacket ; (* Get Init parameters *)
(* Reply with ACK and init parameters *)
OutPacketType := Ord('Y');
PutInitPacket ;
SENDPACKET ;
STATE := RF ;
END (* Got INIT packet *)
else
BEGIN (* Not init packet *)
IF INPACKETTYPE = Ord('E') then
Begin (* Error Packet *)
Writeln(' ') ; Write(' Error Packet >>>> ') ;
For I:=1 to InDataCount Do
Write(Chr(RecvData[i])) ;
Writeln('');
End ; (* Error Packet *)
STATE := A ; (* ABORT if not INIT packet *)
ABORT := NOT_S ;
END ; (* Not init packet *)
END ; (* Initial Receive State *)
(* RF ----- Receive Filename State ------- *)
(* Valid received msg type : S,Z,F,B *)
RF: IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then SENDNAK
else
(* Get a packet *)
IF INPACKETTYPE = Ord('S') then STATE:=R else
IF INPACKETTYPE = Ord('Z') then SendPacketType('N') else
IF INPACKETTYPE = Ord('B') then STATE:=C else
IF INPACKETTYPE = Ord('F') then
BEGIN (* Got file header *)
For i := 1 to InDataCount do
FileName[i] := Chr(RecvData[i]) ;
FileName[0] := Chr(InDataCount) ;
If Filenames = '' then
Myfile := Filename
else
If NewAsfile(Filenames,Filename,MyFiles,Myfile) then;
GotoXY(10,2);
If ReplaceFile then (* write over old file *)
else ReNameDup(Myfile);
Writeln('Receiving file ',Filename,' as ',Myfile,
' ');
Assign(FileComing,Prefixof(MyFiles)+MyFile);
SetTextBuf(FileComing,FileBuffer);
STATE := RD ;
If not ForPrinter then
Begin (* open disk file *)
{$I-} Rewrite(FileComing); {$I+}
If IoResult <> 0 then
Begin (* IO error *)
GotoXY(5,7);
Writeln(' Unable to Open output file. ');
Writeln(' Possibly the Directory is Full ');
STATE := A ;
SendPacketType('N');
End ; (* IO error *)
End ; (* open disk file *)
SendPacketType('Y');
ByteCount := 0 ;
END (* Got file header *)
else
BEGIN (* Not S,F,B,Z packet *)
IF INPACKETTYPE = Ord('E') then
Begin (* Error Packet *)
Writeln(' ') ; Write(' Error Packet >>>> ') ;
For I:=1 to InDataCount Do
Write(Chr(RecvData[i])) ;
Writeln('');
End ; (* Error Packet *)
STATE := A ; (* ABORT if not a S,F,B,Z type packet *)
ABORT := NOT_SFBZ ;
END ; (* Not S,F,B,Z packet *)
(* RD ----- Receive Data State ------- *)
(* Valid received msg type : D,Z *)
RD: IF (NOT RECVPACKET) OR (INPACKETTYPE=Ord('N')) then SENDNAK
else
If lastseqnum = inseq then SendPacketType('Y')
else
BEGIN (* Got a good packet *)
RETRIES := 10 ;
lastseqnum := inseq ;
IF INPACKETTYPE = Ord('D') then
BEGIN (* Receive data *)
PacketCount := PacketCount + 1 ;
Case Breakstate of
NoBreak : SendPacketType('Y');
BC : RECEIVING:=false ;
BE : SendPacketType('N') ;
BX : BreakAck('X') ;
BZ : BreakAck('Z') ;
End; (* Case BreakState *)
If Breakstate <> NoBreak then
Writeln('Receiving file ',Filename,' as ',Myfile,' Interrupted');
If BreakState = BX then Breakstate := NoBreak ;
(* WRITELN ('RECEIVE data '); *)
I := 1 ;
WHILE I <= InDataCount DO
BEGIN (* Write Data to file *)
IF (RepChar<>$20) and (RecvData[I]=RepChar) then
BEGIN (* Repeat char *)
I := I+1 ;
charcount := RecvData[I] - 32 ;
I := I + 1 ;
END (* Repeat char *)
else
charcount := 1 ;
IF (Bit8Quote<>$20) and (RecvData[I]=Bit8Quote) then
BEGIN (* 8TH BIT QUOTING *)
I := I+1 ;
BIT8 := $80 ;
END (* 8TH BIT QUOTING *)
else
BIT8 := 0 ;
IF RecvData[I] = rCntrlQuote then
BEGIN (* CONTROL character *)
I := I+1 ;
IF RecvData[I] = $3F then (* Make it a del *)
RecvData[I] := $7F
else
IF (RecvData[I] >= $40) and (RecvData[I]<=$5F) then
RecvData[I] := RecvData[I] - $40 ;
(* Make it a control *)
(* else assume Quote,8bitQ,or RepChar *)
END ; (* CONTROL character *)
RecvData[I] := RecvData[I] + BIT8 ;
For j := 1 to charcount do
If ForPrinter then
Write(LST,Chr(RecvData[i]))
else
Begin (* Write to file *)
{$I-} Write(FileComing,Chr(RecvData[i])); {$I+}
If IoResult <> 0 then
Begin (* IO error *)
Writeln(' Disk is Full or file too large');
STATE := A ;
SendPacketType('N');
End ; (* IO error *)
End ; (* Write to file *)
ByteCount := ByteCount + charcount ;
I := I + 1 ;
END ; (* Write Data to File *)
GotoXY(44,4) ; Write (PacketCount);
GotoXY(44,5) ; Write (RetryCount);
GotoXY(44,6) ; Writeln(ByteCount,' ');
END (* Receive data *)
else
IF INPACKETTYPE = Ord('F') then
BEGIN (* repeat *)
OutSeq := OutSeq - 1 ;
SendPacketType('Y') ;
END (* repeat *)
else
IF INPACKETTYPE = Ord('Z') then
BEGIN (* End of Incoming File *)
If not ForPrinter then
Begin (* Close file *)
{$I-} Close(FileComing); {$I+}
If IoResult <> 0 then
Writeln(' Disk is Full or file too large');
End ; (* Close file *)
STATE := RF ;
SendPacketType('Y');
END (* End of Incoming File *)
else
BEGIN (* Not D,Z packet *)
IF INPACKETTYPE = Ord('E') then
Begin (* Error Packet *)
Writeln(' ') ; Write(' Error Packet >>>> ') ;
For I:=1 to InDataCount Do
Write(Chr(RecvData[i])) ;
Writeln('');
End ; (* Error Packet *)
STATE := A; (* ABORT - Type not D,Z, *)
ABORT := NOT_DZ ;
END ; (* Not D,Z packet *)
END ; (* Got a good packet *)
(* C ----- COMPLETED State ------- *)
C: BEGIN (* COMPLETED Receiving *)
SendPacketType('Y');
If BreakState = NoBreak then
Writeln ('Receiving files completed OK.')
else
Writeln('Receiving Files terminated by manual interruption');
RECEIVING := FALSE ;
END ; (* COMPLETED Receiving *)
(* A ----- A B O R T State ------- *)
A: BEGIN (* Abort Sending *)
Writeln(' ');
WRITELN ('RECEIVEing file(s) ',filenames,' ABORTED');
{$I-} Close(FileComing);{$I+}
i := IoResult ;
If (i <> 0) and (i <> 103) then
Writeln('Close File IoResult =',i);
RECEIVING := FALSE ;
(* SEND ERROR packet *)
(* OutSeq := 0 ;
ErrorMsg :=' RECVfile abort' ;
OutDataCount := length(ErrorMsg) ;
For i := 1 to length(ErrorMsg) do
SendData[i] := Ord(ErrorMsg[i]) ;
OutPacketType := Ord('E');
SENDPACKET ; *)
END ; (* Abort Sending *)
END ; (* CASE of STATE *)
END ; (* ------- RECVFILE procedure -------*)
End. (* SendRecv Unit *)