home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
os2pm.tar.gz
/
os2pm.tar
/
pad.mod
< prev
next >
Wrap
Text File
|
1990-08-27
|
28KB
|
932 lines
IMPLEMENTATION MODULE PAD; (* Packet Assembler/Disassembler for Kermit *)
FROM SYSTEM IMPORT
ADR;
FROM Storage IMPORT
ALLOCATE, DEALLOCATE;
FROM Screen IMPORT
ClrScr, WriteString, WriteInt, WriteHex, WriteLn;
FROM DosCalls IMPORT
ExitType, DosExit;
FROM Strings IMPORT
Length, Assign;
FROM FileSystem IMPORT
File;
FROM Directories IMPORT
FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;
FROM Files IMPORT
Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;
FROM PMWIN IMPORT
MPARAM, WinPostMsg;
FROM Shell IMPORT
ChildFrameWindow, comport;
FROM KH IMPORT
COM_OFF;
FROM DataLink IMPORT
FlushUART, SendPacket, ReceivePacket;
FROM SYSTEM IMPORT
BYTE;
IMPORT ASCII;
CONST
myMAXL = 94;
myTIME = 10;
myNPAD = 0;
myPADC = 0C;
myEOL = 0C;
myQCTL = '#';
myQBIN = '&';
myCHKT = '1'; (* one character checksum *)
MAXtrys = 5;
(* From DEFINITION MODULE:
PAD_Quit = 0; *)
PAD_SendPacket = 1;
PAD_ResendPacket = 2;
PAD_NoSuchFile = 3;
PAD_ExcessiveErrors = 4;
PAD_ProbClSrcFile = 5;
PAD_ReceivedPacket = 6;
PAD_Filename = 7;
PAD_RequestRepeat = 8;
PAD_DuplicatePacket = 9;
PAD_UnableToOpen = 10;
PAD_ProbClDestFile = 11;
PAD_ErrWrtFile = 12;
PAD_Msg = 13;
TYPE
(* From Definition Module:
PacketType = ARRAY [1..100] OF CHAR;
*)
SMALLSET = SET OF [0..7]; (* a byte *)
VAR
yourMAXL : INTEGER; (* maximum packet length -- up to 94 *)
yourTIME : INTEGER; (* time out -- seconds *)
(* From Definition Module
yourNPAD : INTEGER; (* number of padding characters *)
yourPADC : CHAR; (* padding characters *)
yourEOL : CHAR; (* End Of Line -- terminator *)
*)
yourQCTL : CHAR; (* character for quoting controls '#' *)
yourQBIN : CHAR; (* character for quoting binary '&' *)
yourCHKT : CHAR; (* check type -- 1 = checksum, etc. *)
sF, rF : File; (* files being sent/received *)
InputFileOpen : BOOLEAN;
rFname : ARRAY [0..20] OF CHAR;
sP, rP : PacketType; (* packets sent/received *)
sSeq, rSeq : INTEGER; (* sequence numbers *)
PktNbr : INTEGER; (* actual packet number -- no repeats up to 32,000 *)
ErrorMsg : ARRAY [0..40] OF CHAR;
MP1, MP2 : MPARAM;
PROCEDURE PtrToStr (mp [VALUE] : MPARAM; VAR s : ARRAY OF CHAR);
(* Convert a pointer to a string into a string *)
TYPE
PC = POINTER TO CHAR;
VAR
p : PC;
i : CARDINAL;
c : CHAR;
BEGIN
i := 0;
REPEAT
p := PC (mp);
c := p^;
s[i] := c;
INC (i);
INC (mp.L);
UNTIL c = 0C;
END PtrToStr;
PROCEDURE DoPADMsg (mp1, mp2 [VALUE] : MPARAM);
(* Output messages for Packet Assembler/Disassembler *)
VAR
Message : ARRAY [0..40] OF CHAR;
BEGIN
CASE CARDINAL (mp1.W1) OF
PAD_SendPacket:
WriteString ("Sent Packet #");
WriteInt (mp2.W1, 5);
WriteString (" (ID: "); WriteHex (mp2.W2, 2);
WriteString ("h)");
| PAD_ResendPacket:
WriteString ("ERROR -- Resending:"); WriteLn;
WriteString (" Packet #");
WriteInt (mp2.W1, 5);
WriteString (" (ID: "); WriteHex (mp2.W2, 2);
WriteString ("h)");
| PAD_NoSuchFile:
WriteString ("No such file: ");
PtrToStr (mp2, Message); WriteString (Message);
| PAD_ExcessiveErrors:
WriteString ("Excessive errors ...");
| PAD_ProbClSrcFile:
WriteString ("Problem closing source file...");
| PAD_ReceivedPacket:
WriteString ("Received Packet #");
WriteInt (mp2.W1, 5);
WriteString (" (ID: "); WriteHex (mp2.W2, 2);
WriteString ("h)");
| PAD_Filename:
WriteString ("Filename = ");
PtrToStr (mp2, Message); WriteString (Message);
| PAD_RequestRepeat:
WriteString ("ERROR -- Requesting Repeat:"); WriteLn;
WriteString (" Packet #");
WriteInt (mp2.W1, 5);
WriteString (" (ID: "); WriteHex (mp2.W2, 2);
WriteString ("h)");
| PAD_DuplicatePacket:
WriteString ("Discarding Duplicate:"); WriteLn;
WriteString (" Packet #");
WriteString (" (ID: "); WriteHex (mp2.W2, 2);
WriteString ("h)");
| PAD_UnableToOpen:
WriteString ("Unable to open file: ");
PtrToStr (mp2, Message); WriteString (Message);
| PAD_ProbClDestFile:
WriteString ("Error closing file: ");
PtrToStr (mp2, Message); WriteString (Message);
| PAD_ErrWrtFile:
WriteString ("Error writing to file: ");
PtrToStr (mp2, Message); WriteString (Message);
| PAD_Msg:
PtrToStr (mp2, Message); WriteString (Message);
ELSE
(* Do Nothing *)
END;
WriteLn;
END DoPADMsg;
PROCEDURE CloseInput;
(* Close the input file, if it exists. Reset Input File Open flag *)
BEGIN
IF InputFileOpen THEN
IF CloseFile (sF, Input) = Done THEN
InputFileOpen := FALSE;
ELSE
MP1.W1 := PAD_ProbClSrcFile; MP1.W2 := 0;
MP2.L := LONGINT (ADR (sFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
END;
END;
END CloseInput;
PROCEDURE NormalQuit;
(* Exit from Thread, Post message to Window *)
BEGIN
MP1.W1 := PAD_Quit; MP1.W2 := 0;
MP1.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
DosExit (EXIT_THREAD, 0);
END NormalQuit;
PROCEDURE ErrorQuit;
(* Exit from Thread, Post message to Window *)
BEGIN
MP1.W1 := PAD_Error; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
DosExit (EXIT_THREAD, 0);
END ErrorQuit;
PROCEDURE ByteXor (a, b : BYTE) : BYTE;
BEGIN
RETURN BYTE (SMALLSET (a) / SMALLSET (b));
END ByteXor;
PROCEDURE Char (c : INTEGER) : CHAR;
(* converts a number 0-94 into a printable character *)
BEGIN
RETURN (CHR (CARDINAL (ABS (c) + 32)));
END Char;
PROCEDURE UnChar (c : CHAR) : INTEGER;
(* converts a character into its corresponding number *)
BEGIN
RETURN (ABS (INTEGER (ORD (c)) - 32));
END UnChar;
PROCEDURE TellError (Seq : INTEGER);
(* Send error packet *)
BEGIN
sP[1] := Char (15);
sP[2] := Char (Seq);
sP[3] := 'E'; (* E-type packet *)
sP[4] := 'R'; (* error message starts *)
sP[5] := 'e';
sP[6] := 'm';
sP[7] := 'o';
sP[8] := 't';
sP[9] := 'e';
sP[10] := ' ';
sP[11] := 'A';
sP[12] := 'b';
sP[13] := 'o';
sP[14] := 'r';
sP[15] := 't';
sP[16] := 0C;
SendPacket (sP);
END TellError;
PROCEDURE ShowError (p : PacketType);
(* Output contents of error packet to the screen *)
VAR
i : INTEGER;
BEGIN
FOR i := 4 TO UnChar (p[1]) DO
ErrorMsg[i - 4] := p[i];
END;
ErrorMsg[i - 4] := 0C;
MP1.W1 := PAD_Msg; MP1.W2 := 0;
MP2.L := LONGINT (ADR (ErrorMsg));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
END ShowError;
PROCEDURE youInit (type : CHAR);
(* I initialization YOU for Send and Receive *)
BEGIN
sP[1] := Char (11); (* Length *)
sP[2] := Char (0); (* Sequence *)
sP[3] := type;
sP[4] := Char (myMAXL);
sP[5] := Char (myTIME);
sP[6] := Char (myNPAD);
sP[7] := CHAR (ByteXor (myPADC, 100C));
sP[8] := Char (ORD (myEOL));
sP[9] := myQCTL;
sP[10] := myQBIN;
sP[11] := myCHKT;
sP[12] := 0C; (* terminator *)
SendPacket (sP);
END youInit;
PROCEDURE myInit;
(* YOU initialize ME for Send and Receive *)
VAR
len : INTEGER;
BEGIN
len := UnChar (rP[1]);
IF len >= 4 THEN
yourMAXL := UnChar (rP[4]);
ELSE
yourMAXL := 94;
END;
IF len >= 5 THEN
yourTIME := UnChar (rP[5]);
ELSE
yourTIME := 10;
END;
IF len >= 6 THEN
yourNPAD := UnChar (rP[6]);
ELSE
yourNPAD := 0;
END;
IF len >= 7 THEN
yourPADC := CHAR (ByteXor (rP[7], 100C));
ELSE
yourPADC := 0C;
END;
IF len >= 8 THEN
yourEOL := CHR (UnChar (rP[8]));
ELSE
yourEOL := 0C;
END;
IF len >= 9 THEN
yourQCTL := rP[9];
ELSE
yourQCTL := 0C;
END;
IF len >= 10 THEN
yourQBIN := rP[10];
ELSE
yourQBIN := 0C;
END;
IF len >= 11 THEN
yourCHKT := rP[11];
IF yourCHKT # myCHKT THEN
yourCHKT := '1';
END;
ELSE
yourCHKT := '1';
END;
END myInit;
PROCEDURE SendInit;
BEGIN
youInit ('S');
END SendInit;
PROCEDURE SendFileName;
VAR
i, j : INTEGER;
BEGIN
(* send file name *)
i := 4; j := 0;
WHILE sFname[j] # 0C DO
sP[i] := sFname[j];
INC (i); INC (j);
END;
sP[1] := Char (j + 3);
sP[2] := Char (sSeq);
sP[3] := 'F'; (* filename packet *)
sP[i] := 0C;
SendPacket (sP);
END SendFileName;
PROCEDURE SendEOF;
BEGIN
sP[1] := Char (3);
sP[2] := Char (sSeq);
sP[3] := 'Z'; (* end of file *)
sP[4] := 0C;
SendPacket (sP);
END SendEOF;
PROCEDURE SendEOT;
BEGIN
sP[1] := Char (3);
sP[2] := Char (sSeq);
sP[3] := 'B'; (* break -- end of transmit *)
sP[4] := 0C;
SendPacket (sP);
END SendEOT;
PROCEDURE GetAck() : BOOLEAN;
(* Look for acknowledgement -- retry on timeouts or NAKs *)
VAR
Type : CHAR;
Seq : INTEGER;
retrys : INTEGER;
AckOK : BOOLEAN;
BEGIN
MP1.W1 := PAD_SendPacket; MP1.W2 := 0;
MP2.W1 := PktNbr; MP2.W2 := sSeq;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
retrys := MAXtrys;
LOOP
IF Aborted THEN
TellError (sSeq);
CloseInput;
ErrorQuit;
END;
IF ReceivePacket (rP) THEN
Seq := UnChar (rP[2]);
Type := rP[3];
IF (Seq = sSeq) AND (Type = 'Y') THEN
AckOK := TRUE;
ELSIF (Seq = (sSeq + 1) MOD 64) AND (Type = 'N') THEN
AckOK := TRUE; (* NAK for (n + 1) taken as ACK for n *)
ELSIF Type = 'E' THEN
ShowError (rP);
AckOK := FALSE;
retrys := 0;
ELSE
AckOK := FALSE;
END;
ELSE
AckOK := FALSE;
END;
IF AckOK OR (retrys = 0) THEN
EXIT;
ELSE
MP1.W1 := PAD_ResendPacket; MP1.W2 := 0;
MP2.W1 := PktNbr; MP2.W2 := sSeq;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
DEC (retrys);
FlushUART;
SendPacket (sP);
END;
END;
IF AckOK THEN
INC (PktNbr);
sSeq := (sSeq + 1) MOD 64;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END GetAck;
PROCEDURE GetInitAck() : BOOLEAN;
(* configuration for remote station *)
BEGIN
IF GetAck() THEN
myInit;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END GetInitAck;
PROCEDURE Send;
(* Send one or more files: sFname may be ambiguous *)
TYPE
LP = POINTER TO LIST; (* list of filenames *)
LIST = RECORD
fn : ARRAY [0..20] OF CHAR;
next : LP;
END;
VAR
gotFN : BOOLEAN;
attr : AttributeSet;
ent : DirectoryEntry;
front, back, t : LP; (* add at back of queue, remove from front *)
BEGIN
Aborted := FALSE;
InputFileOpen := FALSE;
front := NIL; back := NIL;
attr := AttributeSet {}; (* normal files only *)
IF Length (sFname) = 0 THEN
MP1.W1 := PAD_Msg; MP1.W2 := 0;
MP2.L := LONGINT (ADR ("No file specified..."));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
ELSE
gotFN := FindFirst (sFname, attr, ent);
WHILE gotFN DO (* build up a list of file names *)
ALLOCATE (t, SIZE (LIST));
Assign (ent.name, t^.fn);
t^.next := NIL;
IF front = NIL THEN
front := t; (* start from empty queue *)
ELSE
back^.next := t; (* and to back of queue *)
END;
back := t;
gotFN := FindNext (ent);
END;
END;
IF front = NIL THEN
MP1.W1 := PAD_NoSuchFile; MP1.W2 := 0;
MP2.L := LONGINT (ADR (sFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
ELSE
sSeq := 0; PktNbr := 0;
FlushUART;
SendInit; (* my configuration information *)
IF NOT GetInitAck() THEN (* get your configuration information *)
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
END;
WHILE front # NIL DO (* send the files *)
Assign (front^.fn, sFname);
PktNbr := 1;
Send1;
t := front;
front := front^.next;
DEALLOCATE (t, SIZE (LIST));
END;
END;
SendEOT;
IF NOT GetAck() THEN
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
CloseInput;
ErrorQuit;
END;
NormalQuit;
END Send;
PROCEDURE Send1;
(* Send one file: sFname *)
VAR
ch : CHAR;
i : INTEGER;
BEGIN
IF Open (sF, sFname) = Done THEN
InputFileOpen := TRUE;
ELSE;
MP1.W1 := PAD_NoSuchFile; MP1.W2 := 0;
MP2.L := LONGINT (ADR (sFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
END;
MP1.W1 := PAD_Filename; MP1.W2 := 0;
MP2.L := LONGINT (ADR (sFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
MP1.W1 := PAD_Msg; MP1.W2 := 0;
MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
SendFileName;
IF NOT GetAck() THEN
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
CloseInput;
ErrorQuit;
END;
(* send file *)
i := 4;
LOOP
IF Get (sF, ch) = EOF THEN (* send current packet & terminate *)
sP[1] := Char (i - 1);
sP[2] := Char (sSeq);
sP[3] := 'D'; (* data packet *)
sP[i] := 0C; (* indicate end of packet *)
SendPacket (sP);
IF NOT GetAck() THEN
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
CloseInput;
ErrorQuit;
END;
SendEOF;
IF NOT GetAck() THEN
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
CloseInput;
ErrorQuit;
END;
EXIT;
END;
IF i >= (yourMAXL - 4) THEN (* send current packet *)
sP[1] := Char (i - 1);
sP[2] := Char (sSeq);
sP[3] := 'D';
sP[i] := 0C;
SendPacket (sP);
IF NOT GetAck() THEN
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
CloseInput;
ErrorQuit;
END;
i := 4;
END;
(* add character to current packet -- update count *)
IF ch > 177C THEN (* must be quoted (QBIN) and altered *)
(* toggle bit 7 to turn it off *)
ch := CHAR (ByteXor (ch, 200C));
sP[i] := myQBIN; INC (i);
END;
IF (ch < 40C) OR (ch = 177C) THEN (* quote (QCTL) and alter *)
(* toggle bit 6 to turn it on *)
ch := CHAR (ByteXor (ch, 100C));
sP[i] := myQCTL; INC (i);
END;
IF (ch = myQCTL) OR (ch = myQBIN) THEN (* must send it quoted *)
sP[i] := myQCTL; INC (i);
END;
sP[i] := ch; INC (i);
END; (* loop *)
CloseInput;
END Send1;
PROCEDURE ReceiveInit() : BOOLEAN;
(* receive my initialization information from you *)
VAR
RecOK : BOOLEAN;
trys : INTEGER;
BEGIN
trys := 1;
LOOP
IF Aborted THEN
TellError (rSeq);
ErrorQuit;
END;
RecOK := ReceivePacket (rP) AND (rP[3] = 'S');
IF RecOK OR (trys = MAXtrys) THEN
EXIT;
ELSE
INC (trys);
SendNak;
END;
END;
IF RecOK THEN
myInit;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END ReceiveInit;
PROCEDURE SendInitAck;
(* acknowledge your initialization of ME and send mine for YOU *)
BEGIN
MP1.W1 := PAD_ReceivedPacket; MP1.W2 := 0;
MP2.W1 := PktNbr; MP2.W2 := rSeq;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
INC (PktNbr);
rSeq := (rSeq + 1) MOD 64;
youInit ('Y');
END SendInitAck;
PROCEDURE ValidFileChar (VAR ch : CHAR) : BOOLEAN;
(* checks if character is one of 'A'..'Z', '0'..'9', makes upper case *)
BEGIN
ch := CAP (ch);
RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= '0') AND (ch <= '9'));
END ValidFileChar;
TYPE
HeaderType = (name, eot, fail);
PROCEDURE ReceiveHeader() : HeaderType;
(* receive the filename -- alter for local conditions, if necessary *)
VAR
i, j, k : INTEGER;
RecOK : BOOLEAN;
trys : INTEGER;
BEGIN
trys := 1;
LOOP
IF Aborted THEN
TellError (rSeq);
ErrorQuit;
END;
RecOK := ReceivePacket (rP) AND ((rP[3] = 'F') OR (rP[3] = 'B'));
IF trys = MAXtrys THEN
RETURN fail;
ELSIF RecOK AND (rP[3] = 'F') THEN
i := 4; (* data starts here *)
j := 0; (* beginning of filename string *)
WHILE (ValidFileChar (rP[i])) AND (j < 8) DO
rFname[j] := rP[i];
INC (i); INC (j);
END;
REPEAT
INC (i);
UNTIL (ValidFileChar (rP[i])) OR (rP[i] = 0C);
rFname[j] := '.'; INC (j);
k := 0;
WHILE (ValidFileChar (rP[i])) AND (k < 3) DO
rFname[j + k] := rP[i];
INC (i); INC (k);
END;
rFname[j + k] := 0C;
MP1.W1 := PAD_Filename; MP1.W2 := 0;
MP2.L := LONGINT (ADR (rFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
RETURN name;
ELSIF RecOK AND (rP[3] = 'B') THEN
RETURN eot;
ELSE
INC (trys);
SendNak;
END;
END;
END ReceiveHeader;
PROCEDURE SendNak;
BEGIN
MP1.W1 := PAD_RequestRepeat; MP1.W2 := 0;
MP2.W1 := PktNbr; MP2.W2 := rSeq;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
FlushUART;
sP[1] := Char (3); (* LEN *)
sP[2] := Char (rSeq);
sP[3] := 'N'; (* negative acknowledgement *)
sP[4] := 0C;
SendPacket (sP);
END SendNak;
PROCEDURE SendAck (Seq : INTEGER);
BEGIN
IF Seq # rSeq THEN
MP1.W1 := PAD_DuplicatePacket; MP1.W2 := 0;
MP2.W1 := 0; MP2.W2 := rSeq;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ELSE
MP1.W1 := PAD_ReceivedPacket; MP1.W2 := 0;
MP2.W1 := PktNbr; MP2.W2 := rSeq;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
rSeq := (rSeq + 1) MOD 64;
INC (PktNbr);
END;
sP[1] := Char (3);
sP[2] := Char (Seq);
sP[3] := 'Y'; (* acknowledgement *)
sP[4] := 0C;
SendPacket (sP);
END SendAck;
PROCEDURE Receive;
(* Receives a file (or files) *)
VAR
ch, Type : CHAR;
Seq : INTEGER;
i : INTEGER;
EOF, EOT, QBIN : BOOLEAN;
trys : INTEGER;
BEGIN
Aborted := FALSE;
MP1.W1 := PAD_Msg; MP1.W2 := 0;
MP2.L := LONGINT (ADR ("Ready to receive file(s)..."));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
MP1.W1 := PAD_Msg; MP1.W2 := 0;
MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
FlushUART;
rSeq := 0; PktNbr := 0;
IF NOT ReceiveInit() THEN (* your configuration information *)
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
END;
SendInitAck; (* send my configuration information *)
EOT := FALSE;
WHILE NOT EOT DO
CASE ReceiveHeader() OF
eot : EOT := TRUE; EOF := TRUE;
| name : IF Create (rF, rFname) # Done THEN
MP1.W1 := PAD_UnableToOpen; MP1.W2 := 0;
MP2.L := LONGINT (ADR (rFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
ELSE
PktNbr := 1;
EOF := FALSE;
END;
| fail : MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
END;
SendAck (rSeq); (* acknowledge for name or eot *)
trys := 1; (* initialize *)
WHILE NOT EOF DO
IF Aborted THEN
TellError (rSeq);
ErrorQuit;
END;
IF ReceivePacket (rP) THEN
Seq := UnChar (rP[2]);
Type := rP[3];
IF Type = 'Z' THEN
EOF := TRUE;
IF CloseFile (rF, Output) = Done THEN
(* normal file termination *)
ELSE
MP1.W1 := PAD_ProbClDestFile; MP1.W2 := 0;
MP2.L := LONGINT (ADR (rFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
END;
trys := 1; (* good packet -- reset *)
SendAck (rSeq);
ELSIF Type = 'E' THEN
ShowError (rP);
ErrorQuit;
ELSIF (Type = 'D') AND ((Seq + 1) MOD 64 = rSeq) THEN
(* discard duplicate packet, and Ack anyway *)
trys := 1;
SendAck (Seq);
ELSIF (Type = 'D') AND (Seq = rSeq) THEN
(* put packet into file buffer *)
i := 4; (* first data in packet *)
WHILE rP[i] # 0C DO
ch := rP[i]; INC (i);
IF ch = yourQBIN THEN
ch := rP[i]; INC (i);
QBIN := TRUE;
ELSE
QBIN := FALSE;
END;
IF ch = yourQCTL THEN
ch := rP[i]; INC (i);
IF (ch # yourQCTL) AND (ch # yourQBIN) THEN
ch := CHAR (ByteXor (ch, 100C));
END;
END;
IF QBIN THEN
ch := CHAR (ByteXor (ch, 200C));
END;
Put (ch);
END;
(* write file buffer to disk *)
IF DoWrite (rF) # Done THEN
MP1.W1 := PAD_ErrWrtFile; MP1.W2 := 0;
MP2.L := LONGINT (ADR (rFname));
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
END;
trys := 1;
SendAck (rSeq);
ELSE
INC (trys);
IF trys = MAXtrys THEN
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
ELSE
SendNak;
END;
END;
ELSE
INC (trys);
IF trys = MAXtrys THEN
MP1.W1 := PAD_ExcessiveErrors; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
ErrorQuit;
ELSE
SendNak;
END;
END;
END;
END;
NormalQuit;
END Receive;
BEGIN (* module initialization *)
yourEOL := ASCII.cr;
yourNPAD := 0;
yourPADC := 0C;
END PAD.