💾 Archived View for spam.works › mirrors › textfiles › computers › andrson2.asc captured on 2023-11-14 at 09:08:52.
⬅️ Previous capture (2023-06-14)
-=-=-=-=-=-=-
_KERMIT FOR OS/2_
by Brian R. Anderson
[LISTING ONE]
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). *)
(* *)
(**************************************************************************)
FROM SYSTEM IMPORT
ADR;
FROM OS2DEF IMPORT
HAB, HWND, HPS, NULL, ULONG;
FROM PMWIN IMPORT
MPARAM, HMQ, QMSG, CS_SIZEREDRAW, WS_VISIBLE, FS_ICON,
FCF_TITLEBAR, FCF_SYSMENU, FCF_SIZEBORDER, FCF_MINMAX, FCF_ACCELTABLE,
FCF_SHELLPOSITION, FCF_TASKLIST, FCF_MENU, FCF_ICON,
SWP_MOVE, SWP_SIZE, SWP_MAXIMIZE,
HWND_DESKTOP, FID_SYSMENU, SC_CLOSE, MIA_DISABLED, MM_SETITEMATTR,
WinInitialize, WinCreateMsgQueue, WinGetMsg, WinDispatchMsg, WinSendMsg,
WinRegisterClass, WinCreateStdWindow, WinDestroyWindow, WinWindowFromID,
WinDestroyMsgQueue, WinTerminate, WinSetWindowText,
WinSetWindowPos, WinQueryWindowPos;
FROM KH IMPORT
IDM_KERMIT;
FROM Shell IMPORT
Class, Title, Child, WindowProc, ChildWindowProc,
FrameWindow, ClientWindow, SetPort, Pos;
CONST
QUEUE_SIZE = 1024; (* Large message queue for async events *)
VAR
AnchorBlock : HAB;
MessageQueue : HMQ;
Message : QMSG;
FrameFlags : ULONG;
hsys : HWND;
MP1, MP2 : MPARAM;
BEGIN (* main *)
AnchorBlock := WinInitialize(0);
IF AnchorBlock # 0 THEN
MessageQueue := WinCreateMsgQueue (AnchorBlock, QUEUE_SIZE);
IF MessageQueue # 0 THEN
(* Register the parent window class *)
WinRegisterClass (
AnchorBlock,
ADR (Class),
WindowProc,
CS_SIZEREDRAW, 0);
(* Register a child window class *)
WinRegisterClass (
AnchorBlock,
ADR (Child),
ChildWindowProc,
CS_SIZEREDRAW, 0);
(* Create a standard window *)
FrameFlags := FCF_TITLEBAR + FCF_MENU + FCF_MINMAX +
FCF_SYSMENU + FCF_SIZEBORDER + FCF_TASKLIST +
FCF_ICON + FCF_SHELLPOSITION + FCF_ACCELTABLE;
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.
[LISTING TWO]
DEFINITION MODULE Shell;
FROM OS2DEF IMPORT
USHORT, HWND;
FROM PMWIN IMPORT
MPARAM, MRESULT, SWP;
EXPORT QUALIFIED
Class, Child, Title, FrameWindow, ClientWindow,
ChildFrameWindow, ChildClientWindow, Pos, SetPort,
WindowProc, ChildWindowProc;
CONST
Class = "PCKermit";
Child ="Child";
Title = "PCKermit -- Microcomputer to Mainframe Communications";
VAR
FrameWindow : HWND;
ClientWindow : HWND;
ChildFrameWindow : HWND;
ChildClientWindow : HWND;
Pos : SWP; (* Screen Dimensions: position & size *)
comport : CARDINAL;
PROCEDURE SetPort;
PROCEDURE WindowProc ['WindowProc'] (
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
PROCEDURE ChildWindowProc ['ChildWindowProc'] (
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
END Shell.
[LISTING THREE]
DEFINITION MODULE Term; (* TVI950 Terminal Emulation For Kermit *)
EXPORT QUALIFIED
WM_TERM, WM_TERMQUIT,
Dir, TermThrProc, InitTerm, PutKbdChar, PutPortChar;
CONST
WM_TERM = 4000H;
WM_TERMQUIT = 4001H;
PROCEDURE Dir (path : ARRAY OF CHAR);
(* Displays a directory *)
PROCEDURE TermThrProc;
(* Thread to get characters from port, put into buffer, send message *)
PROCEDURE InitTerm;
(* Clear Screen, Home Cursor, Get Ready For Terminal Emulation *)
PROCEDURE PutKbdChar (ch1, ch2 : CHAR);
(* Process a character received from the keyboard *)
PROCEDURE PutPortChar (ch : CHAR);
(* Process a character received from the port *)
END Term.
[LISTING FOUR]
DEFINITION MODULE Screen;
(* Module to perform "low level" screen functions (via AVIO) *)
FROM PMAVIO IMPORT
HVPS;
EXPORT QUALIFIED
NORMAL, HIGHLIGHT, REVERSE, attribute, ColorSet, hvps,
White, Green, Amber, Color1, Color2,
ClrScr, ClrEol, GotoXY, GetXY,
Right, Left, Up, Down, Write, WriteLn, WriteString,
WriteInt, WriteHex, WriteAtt;
VAR
NORMAL : CARDINAL;
HIGHLIGHT : CARDINAL;
REVERSE : CARDINAL;
attribute : CARDINAL;
ColorSet : CARDINAL;
hvps : HVPS; (* presentation space used by screen module *)
PROCEDURE White;
(* Sets up colors: Monochrome White *)
PROCEDURE Green;
(* Sets up colors: Monochrome Green *)
PROCEDURE Amber;
(* Sets up colors: Monochrome Amber *)
PROCEDURE Color1;
(* Sets up colors: Blue, Red, Green *)
PROCEDURE Color2;
(* Sets up colors: Green, Magenta, Cyan *)
PROCEDURE ClrScr;
(* Clear the screen, and home the cursor *)
PROCEDURE ClrEol;
(* clear from the current cursor position to the end of the line *)
PROCEDURE Right;
(* move cursor to the right *)
PROCEDURE Left;
(* move cursor to the left *)
PROCEDURE Up;
(* move cursor up *)
PROCEDURE Down;
(* move cursor down *)
PROCEDURE GotoXY (col, row : CARDINAL);
(* position cursor at column, row *)
PROCEDURE GetXY (VAR col, row : CARDINAL);
(* determine current cursor position *)
PROCEDURE Write (c : CHAR);
(* Write a Character, Teletype Mode *)
PROCEDURE WriteString (str : ARRAY OF CHAR);
(* Write String, Teletype Mode *)
PROCEDURE WriteInt (n : INTEGER; s : CARDINAL);
(* Write Integer, Teletype Mode *)
PROCEDURE WriteHex (n, s : CARDINAL);
(* Write a Hexadecimal Number, Teletype Mode *)
PROCEDURE WriteLn;
(* Write <cr> <lf>, Teletype Mode *)
PROCEDURE WriteAtt (c : CHAR);
(* write character and attribute at cursor position *)
END Screen.
[LISTING FIVE]
DEFINITION MODULE PAD; (* Packet Assembler/Disassembler for Kermit *)
FROM PMWIN IMPORT
MPARAM;
EXPORT QUALIFIED
WM_PAD, PAD_Quit, PAD_Error, PacketType, yourNPAD, yourPADC, yourEOL,
Aborted, sFname, Send, Receive, DoPADMsg;
CONST
WM_PAD = 5000H;
PAD_Quit = 0;
PAD_Error = 20;
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) *)
PROCEDURE DoPADMsg (mp1, mp2 [VALUE] : MPARAM);
(* Output messages for Packet Assembler/Disassembler *)
END PAD.
[LISTING SIX]
DEFINITION MODULE DataLink; (* Sends and Receives Packets for PCKermit *)
FROM PMWIN IMPORT
MPARAM;
FROM PAD IMPORT
PacketType;
EXPORT QUALIFIED
WM_DL, FlushUART, SendPacket, ReceivePacket, DoDLMsg;
CONST
WM_DL = 6000H;
PROCEDURE FlushUART;
(* ensure no characters left in UART holding registers *)
PROCEDURE SendPacket (s : PacketType);
(* Adds SOH and CheckSum to packet *)
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 *)
PROCEDURE DoDLMsg (mp1, mp2 [VALUE] : MPARAM);
(* Process DataLink Messages *)
END DataLink.
[LISTING SEVEN]
(*************************************************************)
(* *)
(* Copyright (C) 1988, 1989 *)
(* by Stony Brook Software *)
(* *)
(* All rights reserved. *)
(* *)
(*************************************************************)
DEFINITION MODULE CommPort;
TYPE
CommStatus = (
Success,
InvalidPort,
InvalidParameter,
AlreadyReceiving,
NotReceiving,
NoCharacter,
FramingError,
OverrunError,
ParityError,
BufferOverflow,
TimeOut
);
BaudRate = (
Baud110,
Baud150,
Baud300,
Baud600,
Baud1200,
Baud2400,
Baud4800,
Baud9600,
Baud19200
);
DataBits = [7..8];
StopBits = [1..2];
Parity = (Even, Odd, None);
PROCEDURE InitPort(port : CARDINAL; speed : BaudRate; data : DataBits;
stop : StopBits; check : Parity) : CommStatus;
PROCEDURE StartReceiving(port, bufsize : CARDINAL) : CommStatus;
PROCEDURE StopReceiving(port : CARDINAL) : CommStatus;
PROCEDURE GetChar(port : CARDINAL; VAR ch : CHAR) : CommStatus;
PROCEDURE SendChar(port : CARDINAL; ch : CHAR; modem : BOOLEAN) : CommStatus;
END CommPort.
[LISTING EIGHT]
DEFINITION MODULE Files; (* File I/O for Kermit *)
FROM FileSystem IMPORT
File;
EXPORT QUALIFIED
Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;
TYPE
Status = (Done, Error, EOF);
FileType = (Input, Output);
PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
(* opens an existing file for reading, returns status *)
PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
(* creates a new file for writing, returns status *)
PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
(* closes a file after reading or writing *)
PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
(* Reads one character from the file, returns status *)
PROCEDURE Put (ch : CHAR);
(* Writes one character to the file buffer *)
PROCEDURE DoWrite (VAR f : File) : Status;
(* Writes buffer to disk only if nearly full *)
END Files.
[LISTING NINE]
IMPLEMENTATION MODULE Shell;
FROM SYSTEM IMPORT
ADDRESS, ADR;
IMPORT ASCII;
FROM OS2DEF IMPORT
HWND, HDC, HPS, RECTL, USHORT, NULL, ULONG;
FROM Term IMPORT
WM_TERM, WM_TERMQUIT,
Dir, TermThrProc, InitTerm, PutKbdChar, PutPortChar;
FROM PAD IMPORT
WM_PAD, PAD_Quit, PAD_Error, DoPADMsg, Aborted, sFname, Send, Receive;
FROM DataLink IMPORT
WM_DL, DoDLMsg;
FROM Screen IMPORT
hvps, ColorSet, White, Green, Amber, Color1, Color2, ClrScr, WriteLn;
FROM DosCalls IMPORT
DosCreateThread, DosSuspendThread, DosResumeThread, DosSleep;
FROM PMAVIO IMPORT
VioCreatePS, VioAssociate, VioDestroyPS, VioShowPS, WinDefAVioWindowProc,
FORMAT_CGA, HVPS;
FROM PMWIN IMPORT
MPARAM, MRESULT, SWP, PSWP,
WS_VISIBLE, FCF_TITLEBAR, FCF_SIZEBORDER, FCF_SHELLPOSITION,
WM_SYSCOMMAND, WM_MINMAXFRAME, SWP_MINIMIZE, HWND_DESKTOP,
WM_PAINT, WM_QUIT, WM_COMMAND, WM_INITDLG, WM_CONTROL, WM_HELP,
WM_INITMENU, WM_SIZE, WM_DESTROY, WM_CREATE, WM_CHAR,
BM_SETCHECK, MBID_OK, MB_OK, MB_OKCANCEL,
KC_CHAR, KC_CTRL, KC_VIRTUALKEY, KC_KEYUP,
SWP_SIZE, SWP_MOVE, SWP_MAXIMIZE, SWP_RESTORE,
MB_ICONQUESTION, MB_ICONASTERISK, MB_ICONEXCLAMATION,
FID_MENU, MM_SETITEMATTR, MM_QUERYITEMATTR, MIA_DISABLED, MIA_CHECKED,
WinCreateStdWindow, WinDestroyWindow,
WinOpenWindowDC, WinSendMsg, WinQueryDlgItemText, WinInvalidateRect,
WinDefWindowProc, WinBeginPaint, WinEndPaint, WinQueryWindowRect,
WinSetWindowText, WinSetFocus, WinDlgBox, WinDefDlgProc, WinDismissDlg,
WinMessageBox, WinPostMsg, WinWindowFromID, WinSendDlgItemMsg,
WinSetWindowPos, WinSetActiveWindow;
FROM PMGPI IMPORT
GpiErase;
FROM KH IMPORT
IDM_KERMIT, IDM_FILE, IDM_OPTIONS, IDM_SENDFN, ID_SENDFN,
IDM_DIR, IDM_CONNECT, IDM_SEND, IDM_REC, IDM_DIRPATH, ID_DIRPATH,
IDM_DIREND, IDM_QUIT, IDM_ABOUT, IDM_HELPMENU, IDM_TERMHELP,
IDM_COMPORT, IDM_BAUDRATE, IDM_DATABITS, IDM_STOPBITS, IDM_PARITY,
COM_OFF, ID_COM1, ID_COM2, PARITY_OFF, ID_EVEN, ID_ODD, ID_NONE,
DATA_OFF, ID_DATA7, ID_DATA8, STOP_OFF, ID_STOP1, ID_STOP2,
BAUD_OFF, ID_B110, ID_B150, ID_B300, ID_B600, ID_B1200, ID_B2400,
ID_B4800, ID_B9600, ID_B19K2,
IDM_COLORS, IDM_WHITE, IDM_GREEN, IDM_AMBER, IDM_C1, IDM_C2;
FROM CommPort IMPORT
CommStatus, BaudRate, DataBits, StopBits, Parity, InitPort,
StartReceiving, StopReceiving;
FROM Strings IMPORT
Assign, Append, AppendChar;
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;
PROCEDURE SetMax;
(* Changes window to maximized *)
BEGIN
WinSetWindowPos (FrameWindow, 0,
Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
SWP_MOVE + SWP_SIZE + SWP_MAXIMIZE);
END SetMax;
PROCEDURE SetBanner;
(* Displays Abbreviated Program Title + Port Settings in Title Bar *)
CONST
PortName : ARRAY [0..1] OF ARRAY [0..5] OF CHAR =
[["COM1:", 0C], ["COM2:", 0C]];
BaudName : ARRAY [0..8] OF ARRAY [0..5] OF CHAR =
[["110", 0C], ["150", 0C], ["300", 0C],
["600", 0C], ["1200", 0C], ["2400", 0C],
["4800", 0C], ["9600", 0C], ["19200", 0C]];
ParityName : ARRAY [0..2] OF CHAR = ['E', 'O', 'N'];
BEGIN
WITH Settings[comport - COM_OFF] DO
Assign (Class, Banner);
Append (Banner, " -- ");
Append (Banner, PortName[comport - COM_OFF]);
Append (Banner, BaudName[baudrate - BAUD_OFF]);
AppendChar (Banner, ',');
AppendChar (Banner, ParityName[parity - PARITY_OFF]);
AppendChar (Banner, ',');
AppendChar (Banner, CHR ((databits - DATA_OFF) + 30H));
AppendChar (Banner, ',');
AppendChar (Banner, CHR ((stopbits - STOP_OFF) + 30H));
WinSetWindowText (FrameWindow, ADR (Banner));
END;
END SetBanner;
PROCEDURE SetPort;
(* Sets The Communications Parameters Chosen By User *)
VAR
status : CommStatus;
rc : USHORT;
BEGIN
IF PrevComPort # NONE THEN
StopReceiving (PrevComPort - COM_OFF);
END;
WITH Settings[comport - COM_OFF] DO
status := InitPort (
comport - COM_OFF,
BaudRate (baudrate - BAUD_OFF),
DataBits (databits - DATA_OFF),
StopBits (stopbits - STOP_OFF),
Parity (parity - PARITY_OFF),
);
END;
IF status = Success THEN
StartReceiving (comport - COM_OFF, BUFSIZE);
PrevComPort := comport;
ELSE
rc := WinMessageBox (HWND_DESKTOP, FrameWindow, ADR (PortError),
0, 0, MB_OKCANCEL + MB_ICONEXCLAMATION);
IF rc = MBID_OK THEN
WinPostMsg (FrameWindow, WM_QUIT, MPARAM (0), MPARAM (0));
ELSE (* try the other port *)
IF comport = ID_COM1 THEN
comport := ID_COM2;
ELSE
comport := ID_COM1;
END;
SetPort; (* recursive call for retry *)
END;
END;
SetBanner;
END SetPort;
PROCEDURE MakeChild (msg : ARRAY OF CHAR);
(* Creates a child window for use by send or receive threads *)
VAR
c_hdc : HDC;
BEGIN
WinPostMsg (FrameWindow, WM_SETFULL, MPARAM (0), MPARAM (0));
Disable (IDM_CONNECT);
Disable (IDM_SEND);
Disable (IDM_REC);
Disable (IDM_DIR);
Disable (IDM_OPTIONS);
Disable (IDM_COLORS);
(* Create a client window *)
FrameFlags := FCF_TITLEBAR + FCF_SIZEBORDER;
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);
WinSetWindowText (ChildFrameWindow, ADR (msg));
WinSetActiveWindow (HWND_DESKTOP, ChildFrameWindow);
c_hdc := WinOpenWindowDC (ChildClientWindow);
hvps := child_hvps;
VioAssociate (c_hdc, hvps);
ClrScr; (* clear the hvio window *)
END MakeChild;
PROCEDURE Disable (item : USHORT);
(* Disables and "GREYS" a menu item *)
VAR
h : HWND;
BEGIN
h := WinWindowFromID (FrameWindow, FID_MENU);
MP1.W1 := item; MP1.W2 := 1;
MP2.W1 := MIA_DISABLED; MP2.W2 := MIA_DISABLED;
WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
END Disable;
PROCEDURE Enable (item : USHORT);
(* Enables a menu item *)
VAR
h : HWND;
atr : USHORT;
BEGIN
h := WinWindowFromID (FrameWindow, FID_MENU);
MP1.W1 := item; MP1.W2 := 1;
MP2.W1 := MIA_DISABLED; MP2.W2 := MIA_DISABLED;
atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR, MP1, MP2));
atr := USHORT (BITSET (atr) * (BITSET (MIA_DISABLED) / BITSET (-1)));
MP1.W1 := item; MP1.W2 := 1;
MP2.W1 := MIA_DISABLED; MP2.W2 := atr;
WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
END Enable;
PROCEDURE Check (item : USHORT);
(* Checks a menu item -- indicates that it is selected *)
VAR
h : HWND;
BEGIN
h := WinWindowFromID (FrameWindow, FID_MENU);
MP1.W1 := item; MP1.W2 := 1;
MP2.W1 := MIA_CHECKED; MP2.W2 := MIA_CHECKED;
WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
END Check;
PROCEDURE UnCheck (item : USHORT);
(* Remove check from a menu item *)
VAR
h : HWND;
atr : USHORT;
BEGIN
h := WinWindowFromID (FrameWindow, FID_MENU);
MP1.W1 := item; MP1.W2 := 1;
MP2.W1 := MIA_CHECKED; MP2.W2 := MIA_CHECKED;
atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR, MP1, MP2));
atr := USHORT (BITSET (atr) * (BITSET (MIA_CHECKED) / BITSET (-1)));
MP1.W1 := item; MP1.W2 := 1;
MP2.W1 := MIA_CHECKED; MP2.W2 := atr;
WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
END UnCheck;
PROCEDURE DoMenu (hwnd : HWND; item [VALUE] : MPARAM);
(* Processes Most Menu Interactions *)
VAR
rcl : RECTL;
rc : USHORT;
BEGIN
CASE CARDINAL (item.W1) OF
IDM_DIR:
SetFull;
WinQueryWindowRect (hwnd, rcl);
WinDlgBox (HWND_DESKTOP, hwnd, PathDlgProc, 0, IDM_DIRPATH, 0);
hvps := frame_hvps;
VioAssociate (hdc, hvps);
Dir (Path);
WinDlgBox (HWND_DESKTOP, hwnd, DirEndDlgProc, 0, IDM_DIREND, 0);
VioAssociate (0, hvps);
WinInvalidateRect (hwnd, rcl, 0);
| IDM_CONNECT:
TermMode := TRUE;
Disable (IDM_CONNECT);
Disable (IDM_SEND);
Disable (IDM_REC);
Disable (IDM_DIR);
Disable (IDM_OPTIONS);
Disable (IDM_COLORS);
(* MAXIMIZE Window -- Required for Terminal Emulation *)
SetMax;
hvps := frame_hvps;
VioAssociate (hdc, hvps);
DosResumeThread (TermThr);
InitTerm;
| IDM_SEND:
WinDlgBox (HWND_DESKTOP, hwnd, SendFNDlgProc, 0, IDM_SENDFN, 0);
MakeChild ("Send a File");
DosCreateThread (Send, Thr, ADR (Stack[STKSIZE]));
| IDM_REC:
MakeChild ("Receive a File");
DosCreateThread (Receive, Thr, ADR (Stack[STKSIZE]));
| IDM_QUIT:
rc := WinMessageBox (HWND_DESKTOP, ClientWindow,
ADR ("Do You Really Want To EXIT PCKermit?"),
ADR ("End Session"), 0, MB_OKCANCEL + MB_ICONQUESTION);
IF rc = MBID_OK THEN
StopReceiving (comport - COM_OFF);
WinPostMsg (hwnd, WM_QUIT, MPARAM (0), MPARAM (0));
END;
| IDM_COMPORT:
WinDlgBox (HWND_DESKTOP, hwnd, ComDlgProc, 0, IDM_COMPORT, 0);
SetPort;
| IDM_BAUDRATE:
WinDlgBox (HWND_DESKTOP, hwnd, BaudDlgProc, 0, IDM_BAUDRATE, 0);
SetPort;
| IDM_DATABITS:
WinDlgBox (HWND_DESKTOP, hwnd, DataDlgProc, 0, IDM_DATABITS, 0);
SetPort;
| IDM_STOPBITS:
WinDlgBox (HWND_DESKTOP, hwnd, StopDlgProc, 0, IDM_STOPBITS, 0);
SetPort;
| IDM_PARITY:
WinDlgBox (HWND_DESKTOP, hwnd, ParityDlgProc, 0, IDM_PARITY, 0);
SetPort;
| IDM_WHITE:
UnCheck (ColorSet);
ColorSet := IDM_WHITE;
Check (ColorSet);
White;
| IDM_GREEN:
UnCheck (ColorSet);
ColorSet := IDM_GREEN;
Check (ColorSet);
Green;
| IDM_AMBER:
UnCheck (ColorSet);
ColorSet := IDM_AMBER;
Check (ColorSet);
Amber;
| IDM_C1:
UnCheck (ColorSet);
ColorSet := IDM_C1;
Check (ColorSet);
Color1;
| IDM_C2:
UnCheck (ColorSet);
ColorSet := IDM_C2;
Check (ColorSet);
Color2;
| IDM_ABOUT:
WinDlgBox (HWND_DESKTOP, hwnd, AboutDlgProc, 0, IDM_ABOUT, 0);
ELSE
(* Don't do anything... *)
END;
END DoMenu;
PROCEDURE ComDlgProc ['ComDlgProc'] (
(* Process Dialog Box for choosing COM1/COM2 *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, comport, BM_SETCHECK,
MPARAM (1), MPARAM (0));
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, comport));
RETURN 1;
| WM_CONTROL:
comport := mp1.W1;
RETURN 0;
| WM_COMMAND:
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END ComDlgProc;
PROCEDURE BaudDlgProc ['BaudDlgProc'] (
(* Process Dialog Box for choosing Baud Rate *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, baudrate, BM_SETCHECK,
MPARAM (1), MPARAM (0));
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, baudrate));
RETURN 1;
| WM_CONTROL:
baudrate := mp1.W1;
RETURN 0;
| WM_COMMAND:
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END;
END BaudDlgProc;
PROCEDURE DataDlgProc ['DataDlgProc'] (
(* Process Dialog Box for choosing 7 or 8 data bits *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, databits, BM_SETCHECK,
MPARAM (1), MPARAM (0));
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, databits));
RETURN 1;
| WM_CONTROL:
databits := mp1.W1;
RETURN 0;
| WM_COMMAND:
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END;
END DataDlgProc;
PROCEDURE StopDlgProc ['StopDlgProc'] (
(* Process Dialog Box for choosing 1 or 2 stop bits *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, stopbits, BM_SETCHECK,
MPARAM (1), MPARAM (0));
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, stopbits));
RETURN 1;
| WM_CONTROL:
stopbits := mp1.W1;
RETURN 0;
| WM_COMMAND:
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END;
END StopDlgProc;
PROCEDURE ParityDlgProc ['ParityDlgProc'] (
(* Process Dialog Box for choosing odd, even, or no parity *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, parity, BM_SETCHECK,
MPARAM (1), MPARAM (0));
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, parity));
RETURN 1;
| WM_CONTROL:
parity := mp1.W1;
RETURN 0;
| WM_COMMAND:
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END;
END ParityDlgProc;
PROCEDURE AboutDlgProc ['AboutDlgProc'] (
(* Process "About" Dialog Box *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
IF msg = WM_COMMAND THEN
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END AboutDlgProc;
PROCEDURE SendFNDlgProc ['SendFNDlgProc'] (
(* Process Dialog Box that obtains send filename from user *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
CASE msg OF
WM_INITDLG:
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, ID_SENDFN));
RETURN 1;
| WM_COMMAND:
WinQueryDlgItemText (hwnd, ID_SENDFN, 20, ADR (sFname));
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END SendFNDlgProc;
PROCEDURE PathDlgProc ['PathDlgProc'] (
(* Process Dialog Box that obtains directory path from user *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
CASE msg OF
WM_INITDLG:
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, ID_DIRPATH));
RETURN 1;
| WM_COMMAND:
WinQueryDlgItemText (hwnd, ID_DIRPATH, 60, ADR (Path));
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END PathDlgProc;
PROCEDURE DirEndDlgProc ['DirEndDlgProc'] (
(* Process Dialog Box to allow user to cancel directory *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
IF msg = WM_COMMAND THEN
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END DirEndDlgProc;
PROCEDURE HelpDlgProc ['HelpDlgProc'] (
(* Process Dialog Boxes for the HELP *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
BEGIN
IF msg = WM_COMMAND THEN
WinDismissDlg (hwnd, 1);
RETURN 0;
ELSE
RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
END;
END HelpDlgProc;
PROCEDURE KeyTranslate (mp1, mp2 [VALUE] : MPARAM; VAR c1, c2 : CHAR) : BOOLEAN;
(* Translates WM_CHAR message into ascii keystroke *)
VAR
code : CARDINAL;
fs : BITSET;
VK, KU, CH, CT : BOOLEAN;
BEGIN
fs := BITSET (mp1.W1); (* flags *)
VK := (fs * BITSET (KC_VIRTUALKEY)) # {};
KU := (fs * BITSET (KC_KEYUP)) # {};
CH := (fs * BITSET (KC_CHAR)) # {};
CT := (fs * BITSET (KC_CTRL)) # {};
IF (NOT KU) THEN
code := mp2.W1; (* character code *)
c1 := CHR (code);
c2 := CHR (code DIV 256);
IF ORD (c1) = 0E0H THEN (* function *)
c1 := 0C;
END;
IF CT AND (NOT CH) AND (NOT VK) AND (code # 0) THEN
c1 := CHR (CARDINAL ((BITSET (ORD (c1)) * BITSET (1FH))));
END;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END KeyTranslate;
PROCEDURE WindowProc ['WindowProc'] (
(* Main Window Procedure -- Handles message from PM and elsewhere *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
VAR
ch : CHAR;
hps : HPS;
pswp : PSWP;
c1, c2 : CHAR;
NullRectl [0:0] : RECTL;
BEGIN
CASE msg OF
WM_HELP:
IF TermMode THEN
WinDlgBox (HWND_DESKTOP, hwnd, HelpDlgProc,
0, IDM_TERMHELP, 0);
ELSE
WinDlgBox (HWND_DESKTOP, hwnd, HelpDlgProc,
0, IDM_HELPMENU, 0);
END;
RETURN 0;
| WM_SETFULL:
SetFull;
RETURN 0;
| WM_SETRESTORE:
SetRestore;
RETURN 0;
| WM_SETMAX:
SetMax;
RETURN 0;
| WM_MINMAXFRAME:
pswp := PSWP (mp1);
IF BITSET (pswp^.fs) * BITSET (SWP_MINIMIZE) # {} THEN
(* Don't Display Port Settings While Minimized *)
WinSetWindowText (FrameWindow, ADR (Title));
ELSE
WinSetWindowText (FrameWindow, ADR (Banner));
IF TermMode AND
(BITSET (pswp^.fs) * BITSET (SWP_RESTORE) # {}) THEN
(* Force window to be maximized in terminal mode *)
WinPostMsg (FrameWindow, WM_SETMAX,
MPARAM (0), MPARAM (0));
ELSIF (NOT TermMode) AND
(BITSET (pswp^.fs) * BITSET (SWP_MAXIMIZE) # {}) THEN
(* Prevent maximized window EXCEPT in terminal mode *)
WinPostMsg (FrameWindow, WM_SETRESTORE,
MPARAM (0), MPARAM (0));
ELSE
(* Do Nothing *)
END;
END;
RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
| WM_CREATE:
hdc := WinOpenWindowDC (hwnd);
VioCreatePS (frame_hvps, 25, 80, 0, FORMAT_CGA, 0);
VioCreatePS (child_hvps, 16, 40, 0, FORMAT_CGA, 0);
DosCreateThread (TermThrProc, TermThr, ADR (TermStack[STKSIZE]));
DosSuspendThread (TermThr);
RETURN 0;
| WM_INITMENU:
Check (ColorSet);
RETURN 0;
| WM_COMMAND:
DoMenu (hwnd, mp1);
RETURN 0;
| WM_TERMQUIT:
TermMode := FALSE;
DosSuspendThread (TermThr);
VioAssociate (0, hvps);
(* Restore The Window *)
SetRestore;
Enable (IDM_CONNECT);
Enable (IDM_SEND);
Enable (IDM_REC);
Enable (IDM_DIR);
Enable (IDM_OPTIONS);
Enable (IDM_COLORS);
RETURN 0;
| WM_TERM:
PutPortChar (CHR (mp1.W1)); (* To Screen *)
RETURN 0;
| WM_CHAR:
IF TermMode THEN
IF KeyTranslate (mp1, mp2, c1, c2) THEN
PutKbdChar (c1, c2); (* To Port *)
RETURN 0;
ELSE
RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
END;
ELSE
RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
END;
| WM_PAINT:
hps := WinBeginPaint (hwnd, NULL, NullRectl);
GpiErase (hps);
VioShowPS (25, 80, 0, hvps);
WinEndPaint (hps);
RETURN 0;
| WM_SIZE:
IF TermMode THEN
RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
ELSE
RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
END;
| WM_DESTROY:
VioDestroyPS (frame_hvps);
VioDestroyPS (child_hvps);
RETURN 0;
ELSE
RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
END;
END WindowProc;
PROCEDURE ChildWindowProc ['ChildWindowProc'] (
(* Window Procedure for Send/Receive child windows *)
hwnd : HWND;
msg : USHORT;
mp1 [VALUE] : MPARAM;
mp2 [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
VAR
mp : USHORT;
hps : HPS;
c1, c2 : CHAR;
NullRectl [0:0] : RECTL;
BEGIN
CASE msg OF
WM_PAINT:
hps := WinBeginPaint (hwnd, NULL, NullRectl);
GpiErase (hps);
VioShowPS (16, 40, 0, hvps);
WinEndPaint (hps);
RETURN 0;
| WM_CHAR:
IF KeyTranslate (mp1, mp2, c1, c2) AND (c1 = ESC) THEN
Aborted := TRUE;
RETURN 0;
ELSE
RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
END;
| WM_PAD:
mp := mp1.W1;
IF (mp = PAD_Error) OR (mp = PAD_Quit) THEN
WriteLn;
IF mp = PAD_Error THEN
WinMessageBox (HWND_DESKTOP, hwnd,
ADR ("File Transfer Aborted"),
ADR (Class), 0, MB_OK + MB_ICONEXCLAMATION);
ELSE
WinMessageBox (HWND_DESKTOP, hwnd,
ADR ("File Transfer Completed"),
ADR (Class), 0, MB_OK + MB_ICONASTERISK);
END;
DosSleep (2000);
VioAssociate (0, hvps);
WinDestroyWindow(ChildFrameWindow);
Enable (IDM_CONNECT);
Enable (IDM_SEND);
Enable (IDM_REC);
Enable (IDM_DIR);
Enable (IDM_OPTIONS);
Enable (IDM_COLORS);
ELSE
DoPADMsg (mp1, mp2);
END;
RETURN 0;
| WM_DL:
DoDLMsg (mp1, mp2);
RETURN 0;
| WM_SIZE:
WinSetWindowPos (ChildFrameWindow, 0,
Pos.cx DIV 4, Pos.cy DIV 4,
Pos.cx DIV 2, Pos.cy DIV 2 - 3,
SWP_MOVE + SWP_SIZE);
RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
ELSE
RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
END;
END ChildWindowProc;
BEGIN (* Module Initialization *)
WITH Settings[ID_COM1 - COM_OFF] DO
baudrate := ID_B1200;
parity := ID_EVEN;
databits := ID_DATA7;
stopbits := ID_STOP1;
END;
WITH Settings[ID_COM2 - COM_OFF] DO
baudrate := ID_B19K2;
parity := ID_EVEN;
databits := ID_DATA7;
stopbits := ID_STOP1;
END;
PrevComPort := NONE;
comport := ID_COM1;
TermMode := FALSE; (* Not Initially in Terminal Emulation Mode *)
END Shell.
[LISTING 10 - PART II]
IMPLEMENTATION MODULE Term; (* TVI950 Terminal Emulation for Kermit *)
FROM Drives IMPORT
SetDrive;
FROM Directories IMPORT
FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;
FROM SYSTEM IMPORT
ADR;
FROM DosCalls IMPORT
DosChDir, DosSleep;
FROM Screen IMPORT
ClrScr, ClrEol, GotoXY, GetXY,
Right, Left, Up, Down, WriteAtt, WriteString, WriteLn, Write,
attribute, NORMAL, HIGHLIGHT, REVERSE;
FROM PMWIN IMPORT
MPARAM, WinPostMsg;
FROM Shell IMPORT
comport, FrameWindow;
FROM KH IMPORT
COM_OFF;
FROM CommPort IMPORT
CommStatus, GetChar, SendChar;
FROM Strings IMPORT
Length, Concat;
IMPORT ASCII;
CONST
(* Key codes: Note: F1 -- F12 are actually Shift-F1 -- Shift-F12 *)
F1 = 124C;
F2 = 125C;
F3 = 126C;
F4 = 127C;
F5 = 130C;
F6 = 131C;
F7 = 132C;
F8 = 133C;
F9 = 134C;
F10 = 135C;
F11 = 207C;
F12 = 210C;
AF1 = 213C; (* Alt-F1 *)
AF2 = 214C; (* Alt-F2 *)
INS = 122C;
DEL = 123C;
HOME = 107C;
PGDN = 121C; (* synonym for PF10 *)
PGUP = 111C; (* synonym for PF11 *)
ENDD = 117C; (* synonym for PF12 *)
UPARROW = 110C;
DOWNARROW = 120C;
LEFTARROW = 113C;
RIGHTARROW = 115C;
CtrlX = 30C;
CtrlCaret = 36C;
CtrlZ = 32C;
CtrlL = 14C;
CtrlH = 10C;
CtrlK = 13C;
CtrlJ = 12C;
CtrlV = 26C;
ESC = 33C;
BUFSIZE = 4096; (* character buffer used by term thread *)
VAR
commStat : CommStatus;
echo : (Off, Local, On);
newline: BOOLEAN; (* translate <cr> to <cr><lf> *)
Insert : BOOLEAN;
MP1, MP2 : MPARAM;
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 Function (ch : CHAR);
(* handles the function keys -- including PF1 - PF12, etc. *)
BEGIN
CASE ch OF
F1 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, '@', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F2 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'A', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F3 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'B', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F4 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'C', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F5 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'D', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F6 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'E', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F7 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'F', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F8 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'G', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F9 : commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'H', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F10,
PGDN: commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'I', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F11,
AF1,
PGUP: commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
commStat := SendChar (comport - COM_OFF, 'J', FALSE);
commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
| F12,
AF2,
ENDD: commStat := SendChar (comport - COM_OFF, ESC, FALSE);
commStat := SendChar (comport - COM_OFF, 'Q', FALSE);
| INS : IF NOT Insert THEN
commStat := SendChar (comport - COM_OFF, ESC, FALSE);
commStat := SendChar (comport - COM_OFF, 'E', FALSE);
END;
| DEL : commStat := SendChar (comport - COM_OFF, ESC, FALSE);
commStat := SendChar (comport - COM_OFF, 'R', FALSE);
| HOME : commStat := SendChar (comport - COM_OFF, CtrlZ, FALSE);
| UPARROW : commStat := SendChar (comport - COM_OFF, CtrlK, FALSE);
| DOWNARROW : commStat := SendChar (comport - COM_OFF, CtrlV, FALSE);
| LEFTARROW : commStat := SendChar (comport - COM_OFF, CtrlH, FALSE);
| RIGHTARROW : commStat := SendChar (comport - COM_OFF, CtrlL, FALSE);
ELSE
(* do nothing *)
END;
END Function;
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;
PROCEDURE Escape (ch : CHAR);
(* handles escape sequences *)
BEGIN
CASE ch OF
'*' : ClrScr;
| 'T', 'R' : ClrEol;
| ')' : attribute := NORMAL;
| '(' : attribute := HIGHLIGHT;
| 'f' : InsertMsg;
| 'g' : InsertOn;
ELSE
(* ignore *)
END;
END Escape;
PROCEDURE Cursor (ch : CHAR);
(* handles cursor positioning *)
VAR
x, y : CARDINAL;
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;
BEGIN (* module initialization *)
echo := Off;
newline := FALSE;
Insert := FALSE;
EscState := FALSE;
CurState1 := FALSE;
CurState2 := FALSE;
END Term.
[LISTING ELEVEN]
IMPLEMENTATION MODULE Screen;
(* module to perform "low level" screen functions (via AVIO) *)
IMPORT ASCII;
FROM SYSTEM IMPORT
ADR;
FROM Strings IMPORT
Length;
FROM Conversions IMPORT
IntToString;
FROM KH IMPORT
IDM_GREEN;
FROM Vio IMPORT
VioSetCurPos, VioGetCurPos, VioScrollUp,
VioWrtNCell, VioWrtTTY, VioCell;
CONST
GREY = 07H;
WHITE = 0FH;
REV_GY = 70H;
GREEN = 02H;
LITE_GRN = 0AH;
REV_GRN = 20H;
AMBER = 06H;
LITE_AMB = 0EH;
REV_AMB = 60H;
RED = 0CH;
CY_BK = 0B0H;
CY_BL = 0B9H;
REV_RD = 0CFH;
REV_BL = 9FH;
MAGENTA = 05H;
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;
PROCEDURE WriteString (str : ARRAY OF CHAR);
(* Write String *)
VAR
i : CARDINAL;
c : CHAR;
BEGIN
i := 0;
c := str[i];
WHILE c # 0C DO
Write (c);
INC (i);
c := str[i];
END;
END WriteString;
PROCEDURE WriteInt (n : INTEGER; s : CARDINAL);
(* Write Integer *)
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;
PROCEDURE WriteString (str : ARRAY OF CHAR);
(* Write String *)
VAR
i : CARDINAL;
c : CHAR;
BEGIN
i := 0;
c := str[i];
WHILE c # 0C DO
Write (c);
INC (i);
c := str[i];
END;
END WriteString;
PROCEDURE WriteInt (n : INTEGER; s : CARDINAL);
(* Write Integer *)
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 *)
CONST
Rate : ARRAY BaudRate OF CARDINAL =
[110, 150, 300, 600, 1200, 2400, 4800, 9600, 19200];
TransParity : ARRAY Parity OF BYTE = [2, 1, 0];
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.
[LISTING FOURTEEN]
DEFINITION MODULE KH;
CONST
ID_OK = 25;
PARITY_OFF = 150;
ID_NONE = 152;
ID_ODD = 151;
ID_EVEN = 150;
STOP_OFF = 140;
ID_STOP2 = 142;
ID_STOP1 = 141;
DATA_OFF = 130;
ID_DATA8 = 138;
ID_DATA7 = 137;
BAUD_OFF = 120;
ID_B19K2 = 128;
ID_B9600 = 127;
ID_B4800 = 126;
ID_B2400 = 125;
ID_B1200 = 124;
ID_B600 = 123;
ID_B300 = 122;
ID_B150 = 121;
ID_B110 = 120;
COM_OFF = 100;
ID_COM2 = 101;
ID_COM1 = 100;
IDM_C2 = 24;
IDM_C1 = 23;
IDM_AMBER = 22;
IDM_GREEN = 21;
IDM_WHITE = 20;
IDM_COLORS = 19;
IDM_DIREND = 18;
ID_DIRPATH = 17;
ID_SENDFN = 16;
IDM_DIRPATH = 15;
IDM_SENDFN = 14;
IDM_TERMHELP = 13;
IDM_HELPMENU = 12;
IDM_ABOUT = 11;
IDM_PARITY = 10;
IDM_STOPBITS = 9;
IDM_DATABITS = 8;
IDM_BAUDRATE = 7;
IDM_COMPORT = 6;
IDM_QUIT = 5;
IDM_REC = 4;
IDM_SEND = 3;
IDM_CONNECT = 2;
IDM_DIR = 1;
IDM_OPTIONS = 52;
IDM_FILE = 51;
IDM_KERMIT = 50;
END KH.
[LISTING FIFTEEN]
IMPLEMENTATION MODULE KH;
END KH.
[LISTING SIXTEEN]
#define IDM_KERMIT 50
#define IDM_FILE 51
#define IDM_OPTIONS 52
#define IDM_HELP 0
#define IDM_DIR 1
#define IDM_CONNECT 2
#define IDM_SEND 3
#define IDM_REC 4
#define IDM_QUIT 5
#define IDM_COMPORT 6
#define IDM_BAUDRATE 7
#define IDM_DATABITS 8
#define IDM_STOPBITS 9
#define IDM_PARITY 10
#define IDM_ABOUT 11
#define IDM_HELPMENU 12
#define IDM_TERMHELP 13
#define IDM_SENDFN 14
#define IDM_DIRPATH 15
#define ID_SENDFN 16
#define ID_DIRPATH 17
#define IDM_DIREND 18
#define IDM_COLORS 19
#define IDM_WHITE 20
#define IDM_GREEN 21
#define IDM_AMBER 22
#define IDM_C1 23
#define IDM_C2 24
#define ID_OK 25
#define ID_COM1 100
#define ID_COM2 101
#define ID_B110 120
#define ID_B150 121
#define ID_B300 122
#define ID_B600 123
#define ID_B1200 124
#define ID_B2400 125
#define ID_B4800 126
#define ID_B9600 127
#define ID_B19K2 128
#define ID_DATA7 137
#define ID_DATA8 138
#define ID_STOP1 141
#define ID_STOP2 142
#define ID_EVEN 150
#define ID_ODD 151
#define ID_NONE 152
[LISTING SEVENTEEN]
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
SUBMENU "~Options", IDM_OPTIONS
BEGIN
MENUITEM "~COM port...", IDM_COMPORT
MENUITEM "~Baud rate...", IDM_BAUDRATE
MENUITEM "~Data bits...", IDM_DATABITS
MENUITEM "~Stop bits...", IDM_STOPBITS
MENUITEM "~Parity bits...", IDM_PARITY
END
SUBMENU "~Colors", IDM_COLORS
BEGIN
MENUITEM "~White Mono", IDM_WHITE
MENUITEM "~Green Mono", IDM_GREEN
MENUITEM "~Amber Mono", IDM_AMBER
MENUITEM "Full Color ~1", IDM_C1
MENUITEM "Full Color ~2", IDM_C2
END
MENUITEM "F1=Help", IDM_HELP, MIS_HELP | MIS_BUTTONSEPARATOR
END
ACCELTABLE IDM_KERMIT
BEGIN
"^C", IDM_CONNECT
"^S", IDM_SEND
"^R", IDM_REC
"^X", IDM_QUIT
END
DLGTEMPLATE IDM_COMPORT LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_COMPORT, 129, 91, 143, 54, FS_NOBYTEALIGN | FS_DLGBORDER |
WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
BEGIN
CONTROL "Select COM Port", IDM_COMPORT, 10, 9, 83, 38,
WC_STATIC, SS_GROUPBOX | WS_VISIBLE
CONTROL "COM1", ID_COM1, 30, 25, 43, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
CONTROL "COM2", ID_COM2, 30, 15, 39, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "OK", ID_OK, 101, 10, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_BAUDRATE LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_BAUDRATE, 131, 54, 142, 115, FS_NOBYTEALIGN |
FS_DLGBORDER | WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
BEGIN
CONTROL "Select Baud Rate", IDM_BAUDRATE, 8, 6, 85, 107,
WC_STATIC, SS_GROUPBOX | WS_VISIBLE
CONTROL "110 Baud", ID_B110, 20, 90, 62, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
CONTROL "150 Baud", ID_B150, 20, 80, 57, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "300 Baud", ID_B300, 20, 70, 58, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "600 Baud", ID_B600, 20, 60, 54, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "1200 Baud", ID_B1200, 20, 50, 59, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "2400 Baud", ID_B2400, 20, 40, 63, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "4800 Baud", ID_B4800, 20, 30, 62, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "9600 Baud", ID_B9600, 20, 20, 59, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "19,200 Baud", ID_B19K2, 20, 10, 69, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "OK", ID_OK, 100, 8, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_DATABITS LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_DATABITS, 137, 80, 140, 56, FS_NOBYTEALIGN |
FS_DLGBORDER | WS_VISIBLE | WS_SAVEBITS
BEGIN
CONTROL "Select Data Bits", IDM_DATABITS, 8, 11, 80, 36,
WC_STATIC, SS_GROUPBOX | WS_VISIBLE
CONTROL "7 Data Bits", ID_DATA7, 15, 25, 67, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
CONTROL "8 Data Bits", ID_DATA8, 15, 15, 64, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "OK", ID_OK, 96, 12, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_STOPBITS LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_STOPBITS, 139, 92, 140, 43, FS_NOBYTEALIGN |
FS_DLGBORDER | WS_VISIBLE | WS_SAVEBITS
BEGIN
CONTROL "Select Stop Bits", IDM_STOPBITS, 9, 6, 80, 32,
WC_STATIC, SS_GROUPBOX | WS_VISIBLE
CONTROL "1 Stop Bit", ID_STOP1, 20, 20, 57, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
CONTROL "2 Stop Bits", ID_STOP2, 20, 10, 60, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "OK", ID_OK, 96, 8, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_PARITY LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_PARITY, 138, 84, 134, 57, FS_NOBYTEALIGN | FS_DLGBORDER |
WS_VISIBLE | WS_SAVEBITS
BEGIN
CONTROL "Select Parity", IDM_PARITY, 12, 6, 64, 46, WC_STATIC,
SS_GROUPBOX | WS_VISIBLE
CONTROL "Even", ID_EVEN, 25, 30, 40, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
CONTROL "Odd", ID_ODD, 25, 20, 38, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "None", ID_NONE, 25, 10, 40, 10, WC_BUTTON,
BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
CONTROL "OK", ID_OK, 88, 8, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_ABOUT LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_ABOUT, 93, 74, 229, 88, FS_NOBYTEALIGN | FS_DLGBORDER |
WS_VISIBLE | WS_SAVEBITS
BEGIN
ICON IDM_KERMIT -1, 12, 64, 22, 16
CONTROL "PCKermit for OS/2", 256, 67, 70, 82, 8, WC_STATIC,
SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Copyright (c) 1990 by Brian R. Anderson", 257, 27, 30, 172, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Microcomputer to Mainframe Communications", 259, 13, 50, 199, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL " OK ", 258, 88, 10, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_HELPMENU LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_HELPMENU, 83, 45, 224, 125, FS_NOBYTEALIGN | FS_DLGBORDER |
WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
BEGIN
ICON IDM_KERMIT -1, 14, 99, 21, 16
CONTROL "PCKermit Help Menu", 256, 64, 106, 91, 8, WC_STATIC,
SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "set communications Options .................. Alt, O",
258, 10, 80, 201, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "Connect to Host ................................... Alt, F; C",
259, 10, 70, 204, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "Directory .............................................. Alt, F; D",
260, 10, 60, 207, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "Send a File .......................................... Alt, F; S",
261, 10, 50, 207, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "Receive a File ...................................... Alt, F; R",
262, 10, 40, 209, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "Exit ...................................................... Alt, F; X",
263, 10, 30, 205, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "OK", 264, 83, 9, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
WS_TABSTOP | WS_VISIBLE | BS_DEFAULT
END
END
DLGTEMPLATE IDM_TERMHELP LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_TERMHELP, 81, 20, 238, 177, FS_NOBYTEALIGN |
FS_DLGBORDER | WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
BEGIN
CONTROL "^E = Echo mode", 256, 10, 160, 72, 8, WC_STATIC,
SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "^L = Local echo mode", 257, 10, 150, 97, 8, WC_STATIC,
SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "^T = Terminal Mode (no echo)", 258, 10, 140, 131, 8, WC_STATIC,
SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "^N = Newline mode (<cr> --> <cr><lf>)", 259, 10, 130, 165, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "^O = Newline mode OFF", 260, 10, 120, 109, 8, WC_STATIC,
SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Televideo TVI950 / IBM 7171 Terminal Emulation", 261, 10, 100, 217, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Sh-F1 - Sh-F12 = PF1 - PF12", 262, 10, 90, 135, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Home = Clear", 263, 10, 80, 119, 8, WC_STATIC,
SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "PgDn = Page Down (as used in PROFS)",
264, 10, 70, 228, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "PgUp = Page Up (as used in PROFS)",
265, 10, 60, 227, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "Insert = Insert (Enter to Clear)", 266, 10, 40, 221, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Delete = Delete", 267, 10, 30, 199, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Control-G = Reset (rewrites the screen)",
268, 10, 20, 222, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "Cursor Keys (i.e., Up, Down, Left, Right) all work.",
269, 10, 10, 220, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
WS_GROUP | WS_VISIBLE
CONTROL "OK", 270, 193, 158, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_TABSTOP | WS_VISIBLE
CONTROL "End = End (as used in PROFS)", 271, 10, 50, 209, 8,
WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_SENDFN LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_SENDFN, 113, 90, 202, 60, FS_NOBYTEALIGN | FS_DLGBORDER |
WS_VISIBLE | WS_SAVEBITS
BEGIN
CONTROL "Send File", 256, 4, 4, 195, 24, WC_STATIC, SS_GROUPBOX |
WS_GROUP | WS_VISIBLE
CONTROL "Enter filename:", 257, 13, 11, 69, 8, WC_STATIC, SS_TEXT |
DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
ICON IDM_KERMIT -1, 15, 38, 22, 16
CONTROL "PCKermit for OS/2", 259, 59, 45, 82, 8, WC_STATIC, SS_TEXT |
DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "OK", 260, 154, 36, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
WS_TABSTOP | WS_VISIBLE | BS_DEFAULT
CONTROL "", ID_SENDFN, 89, 10, 98, 8, WC_ENTRYFIELD, ES_LEFT |
ES_MARGIN | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_DIRPATH LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_DIRPATH, 83, 95, 242, 46, FS_NOBYTEALIGN | FS_DLGBORDER |
WS_VISIBLE | WS_SAVEBITS
BEGIN
CONTROL "Directory", 256, 7, 5, 227, 24, WC_STATIC, SS_GROUPBOX |
WS_GROUP | WS_VISIBLE
CONTROL "Path:", 257, 28, 11, 26, 8, WC_STATIC, SS_TEXT | DT_LEFT |
DT_TOP | WS_GROUP | WS_VISIBLE
CONTROL "OK", 258, 185, 31, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
WS_TABSTOP | WS_VISIBLE | BS_DEFAULT
CONTROL "*.*", ID_DIRPATH, 57, 11, 166, 8, WC_ENTRYFIELD, ES_LEFT |
ES_AUTOSCROLL | ES_MARGIN | WS_TABSTOP | WS_VISIBLE
END
END
DLGTEMPLATE IDM_DIREND LOADONCALL MOVEABLE DISCARDABLE
BEGIN
DIALOG "", IDM_DIREND, 149, 18, 101, 27, FS_NOBYTEALIGN | FS_DLGBORDER |
WS_VISIBLE | WS_SAVEBITS
BEGIN
CONTROL "Cancel", 256, 30, 2, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
BS_DEFAULT | WS_TABSTOP | WS_VISIBLE
CONTROL "Directory Complete", 257, 9, 16, 84, 8, WC_STATIC, SS_TEXT |
DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
END
END
[LISTING NINETEEN]
NAME PCKermit WINDOWAPI
DESCRIPTION 'PCKermit: (c) Brian R. Anderson, 1990'
HEAPSIZE 16384
STACKSIZE 8192
PROTMODE
EXETYPE OS2
CODE LOADONCALL EXECUTEREAD NOIOPL NONCONFORMING
DATA LOADONCALL READWRITE MULTIPLE NONSHARED NOIOPL
EXPORTS
WindowProc
ChildWindowProc
ComDlgProc
BaudDlgProc
DataDlgProc
StopDlgProc
ParityDlgProc
AboutDlgProc
SendFNDlgProc
PathDlgProc
DirEndDlgProc
HelpDlgProc
[FILE PCKERMIT]
KH.SYM: KH.DEF
M2 KH.DEF/OUT:KH.SYM
KH.OBJ: KH.MOD KH.SYM
M2 KH.MOD/OUT:KH.OBJ
SHELL.SYM: SHELL.DEF
M2 SHELL.DEF/OUT:SHELL.SYM
TERM.SYM: TERM.DEF
M2 TERM.DEF/OUT:TERM.SYM
PAD.SYM: PAD.DEF
M2 PAD.DEF/OUT:PAD.SYM
DATALINK.SYM: DATALINK.DEF PAD.SYM
M2 DATALINK.DEF/OUT:DATALINK.SYM
COMMPORT.SYM: COMMPORT.DEF
M2 COMMPORT.DEF/OUT:COMMPORT.SYM
FILES.SYM: FILES.DEF
M2 FILES.DEF/OUT:FILES.SYM
pckermit.OBJ: pckermit.MOD SHELL.SYM KH.SYM
M2 pckermit.MOD/OUT:pckermit.OBJ
SCREEN.SYM: SCREEN.DEF
M2 SCREEN.DEF/OUT:SCREEN.SYM
SCREEN.OBJ: SCREEN.MOD KH.SYM SCREEN.SYM
M2 SCREEN.MOD/OUT:SCREEN.OBJ
COMMPORT.OBJ: COMMPORT.MOD COMMPORT.SYM
M2 COMMPORT.MOD/OUT:COMMPORT.OBJ
FILES.OBJ: FILES.MOD FILES.SYM
M2 FILES.MOD/OUT:FILES.OBJ
SHELL.OBJ: SHELL.MOD COMMPORT.SYM KH.SYM SCREEN.SYM DATALINK.SYM PAD.SYM -
TERM.SYM SHELL.SYM
M2 SHELL.MOD/OUT:SHELL.OBJ
TERM.OBJ: TERM.MOD COMMPORT.SYM KH.SYM SHELL.SYM SCREEN.SYM TERM.SYM
M2 TERM.MOD/OUT:TERM.OBJ
PAD.OBJ: PAD.MOD DATALINK.SYM KH.SYM SHELL.SYM FILES.SYM SCREEN.SYM PAD.SYM
M2 PAD.MOD/OUT:PAD.OBJ
DATALINK.OBJ: DATALINK.MOD KH.SYM PAD.SYM COMMPORT.SYM SHELL.SYM SCREEN.SYM -
DATALINK.SYM
M2 DATALINK.MOD/OUT:DATALINK.OBJ
pckermit.res: pckermit.rc pckermit.h pckermit.ico
rc -r pckermit.rc
pckermit.EXE: KH.OBJ pckermit.OBJ SCREEN.OBJ COMMPORT.OBJ FILES.OBJ SHELL.OBJ -
TERM.OBJ PAD.OBJ DATALINK.OBJ
LINK @pckermit.LNK
rc pckermit.res
pckermit.exe: pckermit.res
rc pckermit.res
[ FILE PCKERMIT.LNK]
KH.OBJ+
pckermit.OBJ+
SCREEN.OBJ+
COMMPORT.OBJ+
FILES.OBJ+
SHELL.OBJ+
TERM.OBJ+
PAD.OBJ+
DATALINK.OBJ
pckermit
pckermit
PM+
OS2+
M2LIB+
DOSCALLS
pckermit.edf
[FILE PAD.MOD]
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.