MODULE PCKermit;
(**************************************************************************)
(* *)
(* PCKermit -- by Brian R. Anderson *)
(* Copyright (c) 1990 *)
(* *)
(* PCKermit is an implementation of the Kermit file transfer protocol *)
(* developed at Columbia University. This (OS/2 PM) version is a *)
(* port from the DOS version of Kermit that I wrote two years ago. *)
(* My original DOS version appeared in the May 1989 issue of DDJ. *)
(* *)
(* The current version includes emulation of the TVI950 Video Display *)
(* Terminal for interaction with IBM mainframes (through the IBM 7171). *)
(* *)
(**************************************************************************)
FrameWindow := WinCreateStdWindow (
HWND_DESKTOP, (* handle of the parent window *)
WS_VISIBLE + FS_ICON, (* the window style *)
FrameFlags, (* the window flags *)
ADR(Class), (* the window class *)
NULL, (* the title bar text *)
WS_VISIBLE, (* client window style *)
NULL, (* handle of resource module *)
IDM_KERMIT, (* resource id *)
ClientWindow (* returned client window handle *)
);
IF FrameWindow # 0 THEN
(* Disable the CLOSE item on the system menu *)
hsys := WinWindowFromID (FrameWindow, FID_SYSMENU);
MP1.W1 := SC_CLOSE; MP1.W2 := 1;
MP2.W1 := MIA_DISABLED; MP2.W2 := MIA_DISABLED;
WinSendMsg (hsys, MM_SETITEMATTR, MP1, MP2);
(* Expand Window to Nearly Full Size, And Display the Title *)
WinQueryWindowPos (HWND_DESKTOP, Pos);
WinSetWindowPos (FrameWindow, 0,
Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
SWP_MOVE + SWP_SIZE);
WinSetWindowText (FrameWindow, ADR (Title));
SetPort; (* Try to initialize communications port *)
WHILE WinGetMsg(AnchorBlock, Message, NULL, 0, 0) # 0 DO
WinDispatchMsg(AnchorBlock, Message);
END;
WinDestroyWindow(FrameWindow);
END;
WinDestroyMsgQueue(MessageQueue);
END;
WinTerminate(AnchorBlock);
END;
END PCKermit.
TYPE
(* PacketType used in both PAD and DataLink modules *)
PacketType = ARRAY [1..100] OF CHAR;
VAR
(* yourNPAD, yourPADC, and yourEOL used in both PAD and DataLink *)
yourNPAD : CARDINAL; (* number of padding characters *)
yourPADC : CHAR; (* padding characters *)
yourEOL : CHAR; (* End Of Line -- terminator *)
sFname : ARRAY [0..20] OF CHAR;
Aborted : BOOLEAN;
PROCEDURE Send;
(* Sends a file after prompting for filename *)
PROCEDURE Receive;
(* Receives a file (or files) *)
CONST
WM_SETMAX = 7000H;
WM_SETFULL = 7001H;
WM_SETRESTORE = 7002H;
NONE = 0; (* no port yet initialized *)
STKSIZE = 4096;
BUFSIZE = 4096; (* Port receive buffers: room for two full screens *)
PortError = "Port Is Already In Use -- EXIT? (Cancel Trys Another Port)";
ESC = 33C;
VAR
FrameFlags : ULONG;
TermStack : ARRAY [1..STKSIZE] OF CHAR;
Stack : ARRAY [1..STKSIZE] OF CHAR;
TermThr : CARDINAL;
Thr : CARDINAL;
hdc : HDC;
frame_hvps, child_hvps : HVPS;
TermMode : BOOLEAN;
Path : ARRAY [0..60] OF CHAR;
Banner : ARRAY [0..40] OF CHAR;
PrevComPort : CARDINAL;
Settings : ARRAY [0..1] OF RECORD
baudrate : CARDINAL;
databits : CARDINAL;
parity : CARDINAL;
stopbits : CARDINAL;
END;
MP1, MP2 : MPARAM;
PROCEDURE SetFull;
(* Changes window to full size *)
BEGIN
WinSetWindowPos (FrameWindow, 0,
Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
SWP_MOVE + SWP_SIZE);
END SetFull;
PROCEDURE SetRestore;
(* Changes window to full size FROM maximized *)
BEGIN
WinSetWindowPos (FrameWindow, 0,
Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
SWP_MOVE + SWP_SIZE + SWP_RESTORE);
END SetRestore;
ChildFrameWindow := WinCreateStdWindow (
ClientWindow, (* handle of the parent window *)
WS_VISIBLE, (* the window style *)
FrameFlags, (* the window flags *)
ADR(Child), (* the window class *)
NULL, (* the title bar text *)
WS_VISIBLE, (* client window style *)
NULL, (* handle of resource module *)
IDM_KERMIT, (* resource id *)
ChildClientWindow (* returned client window handle *)
);
WinSetWindowPos (ChildFrameWindow, 0,
Pos.cx DIV 4, Pos.cy DIV 4,
Pos.cx DIV 2, Pos.cy DIV 2 - 3,
SWP_MOVE + SWP_SIZE);
PROCEDURE Dir (path : ARRAY OF CHAR);
(* Change drive and/or directory; display a directory (in wide format) *)
VAR
gotFN : BOOLEAN;
filename : ARRAY [0..20] OF CHAR;
attr : AttributeSet;
ent : DirectoryEntry;
i, j, k : INTEGER;
BEGIN
filename := ""; (* in case no directory change *)
i := Length (path);
IF (i > 2) AND (path[1] = ':') THEN (* drive specifier *)
DEC (i, 2);
SetDrive (ORD (CAP (path[0])) - ORD ('A'));
FOR j := 0 TO i DO (* strip off the drive specifier *)
path[j] := path[j + 2];
END;
END;
IF i # 0 THEN
gotFN := FALSE;
WHILE (i >= 0) AND (path[i] # '\') DO
IF path[i] = '.' THEN
gotFN := TRUE;
END;
DEC (i);
END;
IF gotFN THEN
j := i + 1;
k := 0;
WHILE path[j] # 0C DO
filename[k] := path[j];
INC (k); INC (j);
END;
filename[k] := 0C;
IF (i = -1) OR ((i = 0) AND (path[0] = '\')) THEN
INC (i);
END;
path[i] := 0C;
END;
END;
IF Length (path) # 0 THEN
DosChDir (ADR (path), 0);
END;
IF Length (filename) = 0 THEN
filename := "*.*";
END;
attr := AttributeSet {ReadOnly, Directory, Archive};
i := 1; (* keep track of position on line *)
ClrScr;
gotFN := FindFirst (filename, attr, ent);
WHILE gotFN DO
WriteString (ent.name);
j := Length (ent.name);
WHILE j < 12 DO (* 12 is maximum length for "filename.typ" *)
Write (' ');
INC (j);
END;
INC (i); (* next position on this line *)
IF i > 5 THEN
i := 1; (* start again on new line *)
WriteLn;
ELSE
WriteString (" | ");
END;
gotFN := FindNext (ent);
END;
WriteLn;
END Dir;
PROCEDURE InitTerm;
(* Clear Screen, Home Cursor, Get Ready For Terminal Emulation *)
BEGIN
ClrScr;
Insert := FALSE;
attribute := NORMAL;
END InitTerm;
PROCEDURE PutKbdChar (ch1, ch2 : CHAR);
(* Process a character received from the keyboard *)
BEGIN
IF ch1 = ASCII.enq THEN (* Control-E *)
echo := On;
ELSIF ch1 = ASCII.ff THEN (* Control-L *)
echo := Local;
ELSIF ch1 = ASCII.dc4 THEN (* Control-T *)
echo := Off;
ELSIF ch1 = ASCII.so THEN (* Control-N *)
newline := TRUE;
ELSIF ch1 = ASCII.si THEN (* Control-O *)
newline := FALSE;
ELSIF (ch1 = ASCII.can) OR (ch1 = ESC) THEN
attribute := NORMAL;
WinPostMsg (FrameWindow, WM_TERMQUIT, MPARAM (0), MPARAM (0));
ELSIF ch1 = 0C THEN
Function (ch2);
ELSE
commStat := SendChar (comport - COM_OFF, ch1, FALSE);
IF (echo = On) OR (echo = Local) THEN
WriteAtt (ch1);
END;
END;
END PutKbdChar;
PROCEDURE TermThrProc;
(* Thread to get characters from port, put into buffer *)
VAR
ch : CHAR;
BEGIN
LOOP
IF GetChar (comport - COM_OFF, ch) = Success THEN
MP1.W1 := ORD (ch); MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (FrameWindow, WM_TERM, MP1, MP2);
ELSE
DosSleep (0);
END
END;
END TermThrProc;
VAR
EscState, CurState1, CurState2 : BOOLEAN;
CurChar1 : CHAR;
PROCEDURE PutPortChar (ch : CHAR);
(* Process a character received from the port *)
BEGIN
IF EscState THEN
EscState := FALSE;
IF ch = '=' THEN
CurState1 := TRUE;
ELSE
Escape (ch);
END;
ELSIF CurState1 THEN
CurState1 := FALSE;
CurChar1 := ch;
CurState2 := TRUE;
ELSIF CurState2 THEN
CurState2 := FALSE;
Cursor (ch);
ELSE
CASE ch OF
CtrlCaret, CtrlZ : ClrScr;
| CtrlL : Right;
| CtrlH : Left;
| CtrlK : Up;
| CtrlJ : Down;
| ESC : EscState := TRUE;
ELSE
WriteAtt (ch);
IF newline AND (ch = ASCII.cr) THEN
WriteLn;
END;
END;
END;
IF echo = On THEN
commStat := SendChar (comport - COM_OFF, ch, FALSE);
END;
END PutPortChar;
BEGIN
y := ORD (CurChar1) - 20H;
x := ORD (ch) - 20H;
GotoXY (x, y); (* adjust for HOME = (1, 1) *)
END Cursor;
VAR
cx, cy : CARDINAL;
PROCEDURE InsertMsg;
(* get ready insert mode -- place a message at the bottom of the screen *)
BEGIN
IF NOT Insert THEN
GetXY (cx, cy); (* record current position *)
GotoXY (1, 24);
ClrEol;
attribute := REVERSE;
ELSE (* exit Insert mode *)
GetXY (cx, cy);
GotoXY (1, 24);
ClrEol;
GotoXY (cx, cy);
Insert := FALSE;
END;
END InsertMsg;
PROCEDURE InsertOn;
(* enter insert mode -- after INSERT MODE message is printed *)
BEGIN
attribute := NORMAL;
GotoXY (cx, cy);
Insert := TRUE;
END InsertOn;
VAR
(* From Definition Module
NORMAL : CARDINAL;
HIGHLIGHT : CARDINAL;
REVERSE : CARDINAL;
attribute : CARDINAL;
hvps : HVPS;
*)
x, y : CARDINAL;
bCell : VioCell;
PROCEDURE White;
(* Sets up colors: Monochrome White *)
BEGIN
NORMAL := GREY;
HIGHLIGHT := WHITE;
REVERSE := REV_GY;
attribute := NORMAL;
END White;
PROCEDURE Green;
(* Sets up colors: Monochrome Green *)
BEGIN
NORMAL := GREEN;
HIGHLIGHT := LITE_GRN;
REVERSE := REV_GRN;
attribute := NORMAL;
END Green;
PROCEDURE Amber;
(* Sets up colors: Monochrome Amber *)
BEGIN
NORMAL := AMBER;
HIGHLIGHT := LITE_AMB;
REVERSE := REV_AMB;
attribute := NORMAL;
END Amber;
PROCEDURE Color1;
(* Sets up colors: Blue, Red, Green *)
BEGIN
NORMAL := GREEN;
HIGHLIGHT := RED;
REVERSE := REV_BL;
attribute := NORMAL;
END Color1;
PROCEDURE Color2;
(* Sets up colors: Cyan Background; Black, Blue, White-on-Red *)
BEGIN
NORMAL := CY_BK;
HIGHLIGHT := CY_BL;
REVERSE := REV_RD;
attribute := NORMAL;
END Color2;
PROCEDURE HexToString (num : INTEGER;
size : CARDINAL;
VAR buf : ARRAY OF CHAR;
VAR I : CARDINAL;
VAR Done : BOOLEAN);
(* Local Procedure to convert a number to a string, represented in HEX *)
CONST
ZERO = 30H; (* ASCII code *)
A = 41H;
VAR
i : CARDINAL;
h : CARDINAL;
t : ARRAY [0..10] OF CHAR;
BEGIN
i := 0;
REPEAT
h := num MOD 16;
IF h <= 9 THEN
t[i] := CHR (h + ZERO);
ELSE
t[i] := CHR (h - 10 + A);
END;
INC (i);
num := num DIV 16;
UNTIL num = 0;
IF (size > HIGH (buf)) OR (i > HIGH (buf)) THEN
Done := FALSE;
RETURN;
ELSE
Done := TRUE;
END;
WHILE size > i DO
buf[I] := '0'; (* pad with zeros *)
DEC (size);
INC (I);
END;
WHILE i > 0 DO
DEC (i);
buf[I] := t[i];
INC (I);
END;
buf[I] := 0C;
END HexToString;
PROCEDURE ClrScr;
(* Clear the screen, and home the cursor *)
BEGIN
bCell.ch := ' '; (* space = blank screen *)
bCell.attr := CHR (NORMAL); (* Normal Video Attribute *)
VioScrollUp (0, 0, 24, 79, 25, bCell, hvps);
GotoXY (0, 0);
END ClrScr;
PROCEDURE ClrEol;
(* clear from the current cursor position to the end of the line *)
BEGIN
GetXY (x, y); (* current cursor position *)
bCell.ch := ' '; (* space = blank *)
bCell.attr := CHR (NORMAL); (* Normal Video Attribute *)
VioScrollUp (y, x, y, 79, 1, bCell, hvps);
END ClrEol;
PROCEDURE Right;
(* move cursor to the right *)
BEGIN
GetXY (x, y);
INC (x);
GotoXY (x, y);
END Right;
PROCEDURE Left;
(* move cursor to the left *)
BEGIN
GetXY (x, y);
DEC (x);
GotoXY (x, y);
END Left;
PROCEDURE Up;
(* move cursor up *)
BEGIN
GetXY (x, y);
DEC (y);
GotoXY (x, y);
END Up;
PROCEDURE Down;
(* move cursor down *)
BEGIN
GetXY (x, y);
INC (y);
GotoXY (x, y);
END Down;
PROCEDURE GotoXY (col, row : CARDINAL);
(* position cursor at column, row *)
BEGIN
IF (col <= 79) AND (row <= 24) THEN
VioSetCurPos (row, col, hvps);
END;
END GotoXY;
PROCEDURE GetXY (VAR col, row : CARDINAL);
(* determine current cursor position *)
BEGIN
VioGetCurPos (row, col, hvps);
END GetXY;
PROCEDURE Write (c : CHAR);
(* Write a Character *)
BEGIN
WriteAtt (c);
END Write;
VAR
i : CARDINAL;
b : BOOLEAN;
str : ARRAY [0..6] OF CHAR;
BEGIN
i := 0;
IntToString (n, s, str, i, b);
WriteString (str);
END WriteInt;
PROCEDURE WriteHex (n, s : CARDINAL);
(* Write a Hexadecimal Number *)
VAR
i : CARDINAL;
b : BOOLEAN;
str : ARRAY [0..6] OF CHAR;
BEGIN
i := 0;
HexToString (n, s, str, i, b);
WriteString (str);
END WriteHex;
PROCEDURE WriteLn;
(* Write <cr> <lf> *)
BEGIN
Write (ASCII.cr); Write (ASCII.lf);
END WriteLn;
PROCEDURE WriteAtt (c : CHAR);
(* write character and attribute at cursor position *)
VAR
s : ARRAY [0..1] OF CHAR;
BEGIN
GetXY (x, y);
IF (c = ASCII.ht) THEN
bCell.ch := ' ';
bCell.attr := CHR (attribute);
REPEAT
VioWrtNCell (bCell, 1, y, x, hvps);
Right;
UNTIL (x MOD 8) = 0;
ELSIF (c = ASCII.cr) OR (c = ASCII.lf)
OR (c = ASCII.bel) OR (c = ASCII.bs) THEN
s[0] := c; s[1] := 0C;
VioWrtTTY (ADR (s), 1, hvps);
IF c = ASCII.lf THEN
ClrEol;
END;
ELSE
bCell.ch := c;
bCell.attr := CHR (attribute);
VioWrtNCell (bCell, 1, y, x, hvps);
Right;
END;
END WriteAtt;
BEGIN (* module initialization *)
ColorSet := IDM_GREEN;
NORMAL := GREEN;
HIGHLIGHT := LITE_GRN;
REVERSE := REV_GRN;
attribute := NORMAL;
END Screen.
bCell.ch := ' '; (* space = blank *)
bCell.attr := CHR (NORMAL); (* Normal Video Attribute *)
VioScrollUp (y, x, y, 79, 1, bCell, hvps);
END ClrEol;
PROCEDURE Right;
(* move cursor to the right *)
BEGIN
GetXY (x, y);
INC (x);
GotoXY (x, y);
END Right;
PROCEDURE Left;
(* move cursor to the left *)
BEGIN
GetXY (x, y);
DEC (x);
GotoXY (x, y);
END Left;
PROCEDURE Up;
(* move cursor up *)
BEGIN
GetXY (x, y);
DEC (y);
GotoXY (x, y);
END Up;
PROCEDURE Down;
(* move cursor down *)
BEGIN
GetXY (x, y);
INC (y);
GotoXY (x, y);
END Down;
PROCEDURE GotoXY (col, row : CARDINAL);
(* position cursor at column, row *)
BEGIN
IF (col <= 79) AND (row <= 24) THEN
VioSetCurPos (row, col, hvps);
END;
END GotoXY;
PROCEDURE GetXY (VAR col, row : CARDINAL);
(* determine current cursor position *)
BEGIN
VioGetCurPos (row, col, hvps);
END GetXY;
PROCEDURE Write (c : CHAR);
(* Write a Character *)
BEGIN
WriteAtt (c);
END Write;
VAR
i : CARDINAL;
b : BOOLEAN;
str : ARRAY [0..6] OF CHAR;
BEGIN
i := 0;
IntToString (n, s, str, i, b);
WriteString (str);
END WriteInt;
PROCEDURE WriteHex (n, s : CARDINAL);
(* Write a Hexadecimal Number *)
VAR
i : CARDINAL;
b : BOOLEAN;
str : ARRAY [0..6] OF CHAR;
BEGIN
i := 0;
HexToString (n, s, str, i, b);
WriteString (str);
END WriteHex;
PROCEDURE WriteLn;
(* Write <cr> <lf> *)
BEGIN
Write (ASCII.cr); Write (ASCII.lf);
END WriteLn;
PROCEDURE WriteAtt (c : CHAR);
(* write character and attribute at cursor position *)
VAR
s : ARRAY [0..1] OF CHAR;
BEGIN
GetXY (x, y);
IF (c = ASCII.ht) THEN
bCell.ch := ' ';
bCell.attr := CHR (attribute);
REPEAT
VioWrtNCell (bCell, 1, y, x, hvps);
Right;
UNTIL (x MOD 8) = 0;
ELSIF (c = ASCII.cr) OR (c = ASCII.lf)
OR (c = ASCII.bel) OR (c = ASCII.bs) THEN
s[0] := c; s[1] := 0C;
VioWrtTTY (ADR (s), 1, hvps);
IF c = ASCII.lf THEN
ClrEol;
END;
ELSE
bCell.ch := c;
bCell.attr := CHR (attribute);
VioWrtNCell (bCell, 1, y, x, hvps);
Right;
END;
END WriteAtt;
BEGIN (* module initialization *)
ColorSet := IDM_GREEN;
NORMAL := GREEN;
HIGHLIGHT := LITE_GRN;
REVERSE := REV_GRN;
attribute := NORMAL;
END Screen.
[LISTING TWELVE]
(**************************************************************************)
(* *)
(* Copyright (c) 1988, 1989 *)
(* by Stony Brook Software *)
(* and *)
(* Copyright (c) 1990 *)
(* by Brian R. Anderson *)
(* All rights reserved. *)
(* *)
(**************************************************************************)
IMPLEMENTATION MODULE CommPort [7];
FROM SYSTEM IMPORT
ADR, BYTE, WORD, ADDRESS;
FROM Storage IMPORT
ALLOCATE, DEALLOCATE;
FROM DosCalls IMPORT
DosOpen, AttributeSet, DosDevIOCtl, DosClose, DosRead, DosWrite;
TYPE
CP = POINTER TO CHAR;
VAR
pn : CARDINAL;
Handle : ARRAY [0..3] OF CARDINAL;
BufIn : ARRAY [0..3] OF CP;
BufOut : ARRAY [0..3] OF CP;
BufStart : ARRAY [0..3] OF CP;
BufLimit : ARRAY [0..3] OF CP;
BufSize : ARRAY [0..3] OF CARDINAL;
Temp : ARRAY [1..1024] OF CHAR; (* size of OS/2's serial queue *)
PROCEDURE CheckPort (portnum : CARDINAL) : BOOLEAN;
(* Check for a valid port number and open the port if it not alredy open *)
CONST
PortName : ARRAY [0..3] OF ARRAY [0..4] OF CHAR =
[['COM1', 0C], ['COM2', 0C], ['COM3', 0C], ['COM4', 0C]];
VAR
Action : CARDINAL;
BEGIN
(* check the port number *)
IF portnum > 3 THEN
RETURN FALSE;
END;
(* attempt to open the port if it is not already open *)
IF Handle[portnum] = 0 THEN
IF DosOpen(ADR(PortName[portnum]), Handle[portnum], Action, 0,
AttributeSet{}, 1, 12H, 0) # 0 THEN
RETURN FALSE;
END;
END;
RETURN TRUE;
END CheckPort;
PROCEDURE InitPort (portnum : CARDINAL; speed : BaudRate; data : DataBits;
stop : StopBits; check : Parity) : CommStatus;
(* Initialize a port *)
TYPE
LineChar = RECORD
bDataBits : BYTE;
bParity : BYTE;
bStopBits : BYTE;
END;
VAR
LC : LineChar;
BEGIN
(* Check the port number *)
IF NOT CheckPort(portnum) THEN
RETURN InvalidPort;
END;
(* Set the baud rate *)
IF DosDevIOCtl(0, ADR(Rate[speed]), 41H, 1, Handle[portnum]) # 0 THEN
RETURN InvalidParameter;
END;
(* set the characteristics *)
LC.bDataBits := BYTE(data);
IF stop = 1 THEN
DEC (stop); (* 0x00 = 1 stop bits; 0x02 = 2 stop bits *)
END;
LC.bStopBits := BYTE(stop);
LC.bParity := TransParity[check];
IF DosDevIOCtl(0, ADR(LC), 42H, 1, Handle[portnum]) # 0 THEN
RETURN InvalidParameter;
END;
RETURN Success;
END InitPort;
PROCEDURE StartReceiving (portnum, bufsize : CARDINAL) : CommStatus;
(* Start receiving characters on a port *)
BEGIN
IF NOT CheckPort(portnum) THEN
RETURN InvalidPort;
END;
IF BufStart[portnum] # NIL THEN
RETURN AlreadyReceiving;
END;
ALLOCATE (BufStart[portnum], bufsize);
BufIn[portnum] := BufStart[portnum];
BufOut[portnum] := BufStart[portnum];
BufLimit[portnum] := BufStart[portnum];
INC (BufLimit[portnum]:ADDRESS, bufsize - 1);
BufSize[portnum] := bufsize;
RETURN Success;
END StartReceiving;
PROCEDURE StopReceiving (portnum : CARDINAL) : CommStatus;
(* Stop receiving characters on a port *)
BEGIN
IF NOT CheckPort(portnum) THEN
RETURN InvalidPort;
END;
IF BufStart[portnum] # NIL THEN
DEALLOCATE (BufStart[portnum], BufSize[portnum]);
BufLimit[portnum] := NIL;
BufIn[portnum] := NIL;
BufOut[portnum] := NIL;
BufSize[portnum] := 0;
END;
DosClose(Handle[portnum]);
Handle[portnum] := 0;
RETURN Success;
END StopReceiving;
PROCEDURE GetChar (portnum : CARDINAL; VAR ch : CHAR) : CommStatus;
(* Get a character from the comm port *)
VAR
status : CARDINAL;
read : CARDINAL;
que : RECORD
ct : CARDINAL;
sz : CARDINAL;
END;
i : CARDINAL;
BEGIN
IF BufStart[portnum] = NIL THEN
RETURN NotReceiving;
END;
IF NOT CheckPort(portnum) THEN
RETURN InvalidPort;
END;
status := DosDevIOCtl (ADR (que), 0, 68H, 1, Handle[portnum]);
IF (status = 0) AND (que.ct # 0) THEN
status := DosRead (Handle[portnum], ADR (Temp), que.ct, read);
IF (status # 0) OR (read = 0) THEN
RETURN NotReceiving;
END;
FOR i := 1 TO read DO
BufIn[portnum]^ := Temp[i];
IF BufIn[portnum] = BufLimit[portnum] THEN
BufIn[portnum] := BufStart[portnum];
ELSE
INC (BufIn[portnum]:ADDRESS);
END;
IF BufIn[portnum] = BufOut[portnum] THEN
RETURN BufferOverflow;
END;
END;
END;
IF BufIn[portnum] = BufOut[portnum] THEN
RETURN NoCharacter;
END;
ch := BufOut[portnum]^;
IF BufOut[portnum] = BufLimit[portnum] THEN
BufOut[portnum] := BufStart[portnum];
ELSE
INC (BufOut[portnum]:ADDRESS);
END;
RETURN Success;
END GetChar;
PROCEDURE SendChar (portnum : CARDINAL; ch : CHAR;
modem : BOOLEAN) : CommStatus;
(* send a character to the comm port *)
VAR
wrote : CARDINAL;
status : CARDINAL;
commSt : CHAR;
BEGIN
IF NOT CheckPort(portnum) THEN
RETURN InvalidPort;
END;
status := DosDevIOCtl (ADR (commSt), 0, 64H, 1, Handle[portnum]);
IF (status # 0) OR (commSt # 0C) THEN
RETURN TimeOut;
ELSE
status := DosWrite(Handle[portnum], ADR(ch), 1, wrote);
IF (status # 0) OR (wrote # 1) THEN
RETURN TimeOut;
ELSE
RETURN Success;
END;
END;
END SendChar;
BEGIN (* module initialization *)
(* nothing open yet *)
FOR pn := 0 TO 3 DO
Handle[pn] := 0;
BufStart[pn] := NIL;
BufLimit[pn] := NIL;
BufIn[pn] := NIL;
BufOut[pn] := NIL;
BufSize[pn] := 0;
END;
END CommPort.
[LISTING THIRTEEN]
IMPLEMENTATION MODULE Files; (* File I/O for Kermit *)
FROM FileSystem IMPORT
File, Response, Delete, Lookup, Close, ReadNBytes, WriteNBytes;
FROM Strings IMPORT
Append;
FROM Conversions IMPORT
CardToString;
FROM SYSTEM IMPORT
ADR, SIZE;
TYPE
buffer = ARRAY [1..512] OF CHAR;
VAR
ext : CARDINAL; (* new file extensions to avoid name conflict *)
inBuf, outBuf : buffer;
inP, outP : CARDINAL; (* buffer pointers *)
read, written : CARDINAL; (* number of bytes read or written *)
(* by ReadNBytes or WriteNBytes *)
PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
(* opens an existing file for reading, returns status *)
BEGIN
Lookup (f, name, FALSE);
IF f.res = done THEN
inP := 0; read := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END Open;
PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
(* creates a new file for writing, returns status *)
VAR
ch : CHAR;
str : ARRAY [0..3] OF CHAR;
i : CARDINAL;
b : BOOLEAN;
BEGIN
LOOP
Lookup (f, name, FALSE); (* check to see if file exists *)
IF f.res = done THEN
Close (f);
(* Filename Clash: Change file name *)
IF ext > 99 THEN (* out of new names... *)
RETURN Error;
END;
i := 0;
WHILE (name[i] # 0C) AND (name[i] # '.') DO
INC (i); (* scan for end of filename *)
END;
name[i] := '.'; name[i + 1] := 'K'; name[i + 2] := 0C;
i := 0;
CardToString (ext, 1, str, i, b);
Append (name, str); (* append new extension *)
INC (ext);
ELSE
EXIT;
END;
END;
Lookup (f, name, TRUE);
IF f.res = done THEN
outP := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END Create;
PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
(* closes a file after reading or writing *)
BEGIN
written := outP;
IF (Which = Output) AND (outP > 0) THEN
WriteNBytes (f, ADR (outBuf), outP);
written := f.count;
END;
Close (f);
IF (written = outP) AND (f.res = done) THEN
RETURN Done;
ELSE
RETURN Error;
END;
END CloseFile;
PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
(* Reads one character from the file, returns status *)
BEGIN
IF inP = read THEN
ReadNBytes (f, ADR (inBuf), SIZE (inBuf));
read := f.count;
inP := 0;
END;
IF read = 0 THEN
RETURN EOF;
ELSE
INC (inP);
ch := inBuf[inP];
RETURN Done;
END;
END Get;
PROCEDURE Put (ch : CHAR);
(* Writes one character to the file buffer *)
BEGIN
INC (outP);
outBuf[outP] := ch;
END Put;
PROCEDURE DoWrite (VAR f : File) : Status;
(* Writes buffer to disk only if nearly full *)
BEGIN
IF outP < 400 THEN (* still room in buffer *)
RETURN Done;
ELSE
WriteNBytes (f, ADR (outBuf), outP);
written := f.count;
IF (written = outP) AND (f.res = done) THEN
outP := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END;
END DoWrite;
BEGIN (* module initialization *)
ext := 0;
END Files.
IMPLEMENTATION MODULE DataLink; (* Sends and Receives Packets for PCKermit *)
FROM ElapsedTime IMPORT
StartTime, GetTime;
FROM Screen IMPORT
ClrScr, WriteString, WriteLn;
FROM PMWIN IMPORT
MPARAM, WinPostMsg;
FROM Shell IMPORT
ChildFrameWindow, comport;
FROM CommPort IMPORT
CommStatus, GetChar, SendChar;
FROM PAD IMPORT
PacketType, yourNPAD, yourPADC, yourEOL;
FROM KH IMPORT
COM_OFF;
FROM SYSTEM IMPORT
BYTE;
IMPORT ASCII;
CONST
MAXtime = 100; (* hundredths of a second -- i.e., one second *)
MAXsohtrys = 100;
DL_BadCS = 1;
DL_NoSOH = 2;
TYPE
SMALLSET = SET OF [0..7]; (* BYTE *)
VAR
ch : CHAR;
status : CommStatus;
MP1, MP2 : MPARAM;
PROCEDURE Delay (t : CARDINAL);
(* delay time in milliseconds *)
VAR
tmp : LONGINT;
BEGIN
tmp := t DIV 10;
StartTime;
WHILE GetTime() < tmp DO
END;
END Delay;
PROCEDURE ByteAnd (a, b : BYTE) : BYTE;
BEGIN
RETURN BYTE (SMALLSET (a) * SMALLSET (b));
END ByteAnd;
PROCEDURE Char (c : INTEGER) : CHAR;
(* converts a number 0-95 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 FlushUART;
(* ensure no characters left in UART holding registers *)
BEGIN
Delay (500);
REPEAT
status := GetChar (comport - COM_OFF, ch);
UNTIL status = NoCharacter;
END FlushUART;
PROCEDURE SendPacket (s : PacketType);
(* Adds SOH and CheckSum to packet *)
VAR
i : CARDINAL;
checksum : INTEGER;
BEGIN
Delay (10); (* give host a chance to catch its breath *)
FOR i := 1 TO yourNPAD DO
status := SendChar (comport - COM_OFF, yourPADC, FALSE);
END;
status := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
i := 1;
checksum := 0;
WHILE s[i] # 0C DO
INC (checksum, ORD (s[i]));
status := SendChar (comport - COM_OFF, s[i], FALSE);
INC (i);
END;
checksum := checksum + (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
checksum := INTEGER (BITSET (checksum) * {5, 4, 3, 2, 1, 0});
status := SendChar (comport - COM_OFF, Char (checksum), FALSE);
IF yourEOL # 0C THEN
status := SendChar (comport - COM_OFF, yourEOL, FALSE);
END;
END SendPacket;
PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
(* strips SOH and checksum -- returns status: TRUE = good packet *)
(* received; FALSE = timed out waiting for packet or checksum error *)
VAR
sohtrys : INTEGER;
i, len : INTEGER;
ch : CHAR;
checksum : INTEGER;
mycheck, yourcheck : CHAR;
BEGIN
sohtrys := MAXsohtrys;
REPEAT
StartTime;
REPEAT
status := GetChar (comport - COM_OFF, ch);
UNTIL (status = Success) OR (GetTime() > MAXtime);
ch := CHAR (ByteAnd (ch, 177C)); (* mask off MSB *)
(* skip over up to MAXsohtrys padding characters, *)
(* but allow only MAXsohtrys/10 timeouts *)
IF status = Success THEN
DEC (sohtrys);
ELSE
DEC (sohtrys, 10);
END;
UNTIL (ch = ASCII.soh) OR (sohtrys <= 0);
IF ch = ASCII.soh THEN
(* receive rest of packet *)
StartTime;
REPEAT
status := GetChar (comport - COM_OFF, ch);
UNTIL (status = Success) OR (GetTime() > MAXtime);
ch := CHAR (ByteAnd (ch, 177C));
len := UnChar (ch);
r[1] := ch;
checksum := ORD (ch);
i := 2; (* on to second character in packet -- after LEN *)
REPEAT
StartTime;
REPEAT
status := GetChar (comport - COM_OFF, ch);
UNTIL (status = Success) OR (GetTime() > MAXtime);
ch := CHAR (ByteAnd (ch, 177C));
r[i] := ch; INC (i);
INC (checksum, (ORD (ch)));
UNTIL (i > len);
(* get checksum character *)
StartTime;
REPEAT
status := GetChar (comport - COM_OFF, ch);
UNTIL (status = Success) OR (GetTime() > MAXtime);
ch := CHAR (ByteAnd (ch, 177C));
yourcheck := ch;
r[i] := 0C;
checksum := checksum +
(INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
checksum := INTEGER (BITSET (checksum) * {5, 4, 3, 2, 1, 0});
mycheck := Char (checksum);
IF mycheck = yourcheck THEN (* checksum OK *)
RETURN TRUE;
ELSE (* ERROR!!! *)
MP1.W1 := DL_BadCS; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
RETURN FALSE;
END;
ELSE
MP1.W1 := DL_NoSOH; MP1.W2 := 0;
MP2.L := 0;
WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
RETURN FALSE;
END;
END ReceivePacket;
PROCEDURE DoDLMsg (mp1, mp2 [VALUE] : MPARAM);
(* Process DataLink Messages *)
BEGIN
CASE CARDINAL (mp1.W1) OF
DL_BadCS:
WriteString ("Bad Checksum"); WriteLn;
| DL_NoSOH:
WriteString ("No SOH"); WriteLn;
ELSE
(* Do Nothing *)
END;
END DoDLMsg;
END DataLink.
[LISTING EIGHTEEN]
#include <os2.h>
#include "pckermit.h"
ICON IDM_KERMIT pckermit.ico
MENU IDM_KERMIT
BEGIN
SUBMENU "~File", IDM_FILE
BEGIN
MENUITEM "~Directory...", IDM_DIR
MENUITEM "~Connect\t^C", IDM_CONNECT
MENUITEM "~Send...\t^S", IDM_SEND
MENUITEM "~Receive...\t^R", IDM_REC
MENUITEM SEPARATOR
MENUITEM "E~xit\t^X", IDM_QUIT
MENUITEM "A~bout PCKermit...", IDM_ABOUT
END
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 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;
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;
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;
