archive:computers:anderson
_KERMIT FOR OS/2_ by Brian R. Anderson
[LISTING ONE]
MODULE PCKermit; () (* *) (* PCKermit – by Brian R. Anderson *) (* Copyright © 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
MPFROM2SHORT, 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;
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);
WinSendMsg (hsys, MM_SETITEMATTR,
MPFROM2SHORT (SC_CLOSE, 1),
MPFROM2SHORT (MIA_DISABLED, MIA_DISABLED));
(* Expand Window to Nearly Full Size, And Display the Title *)
WinQueryWindowPos (HWND_DESKTOP, ADR (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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
PROCEDURE ChildWindowProc ['ChildWindowProc'] (
hwnd : HWND;
msg : USHORT;
mp1 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
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 : 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 : 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
LOWORD, HIWORD, 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, MPFROM2SHORT,
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;
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, 0, 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, 0, 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);
WinSendMsg (h, MM_SETITEMATTR,
MPFROM2SHORT (item, 1),
MPFROM2SHORT (MIA_DISABLED, MIA_DISABLED));
END Disable;
PROCEDURE Enable (item : USHORT);
(* Enables a menu item *)
VAR
h : HWND;
atr : USHORT;
BEGIN
h := WinWindowFromID (FrameWindow, FID_MENU);
atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR,
MPFROM2SHORT (item, 1),
MPFROM2SHORT (MIA_DISABLED, MIA_DISABLED)));
atr := USHORT (BITSET (atr) * (BITSET (MIA_DISABLED) / BITSET (-1)));
WinSendMsg (h, MM_SETITEMATTR,
MPFROM2SHORT (item, 1),
MPFROM2SHORT (MIA_DISABLED, atr));
END Enable;
PROCEDURE Check (item : USHORT);
(* Checks a menu item -- indicates that it is selected *)
VAR
h : HWND;
BEGIN
h := WinWindowFromID (FrameWindow, FID_MENU);
WinSendMsg (h, MM_SETITEMATTR,
MPFROM2SHORT (item, 1),
MPFROM2SHORT (MIA_CHECKED, MIA_CHECKED));
END Check;
PROCEDURE UnCheck (item : USHORT);
(* Remove check from a menu item *)
VAR
h : HWND;
atr : USHORT;
BEGIN
h := WinWindowFromID (FrameWindow, FID_MENU);
atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR,
MPFROM2SHORT (item, 1),
MPFROM2SHORT (MIA_CHECKED, MIA_CHECKED)));
atr := USHORT (BITSET (atr) * (BITSET (MIA_CHECKED) / BITSET (-1)));
WinSendMsg (h, MM_SETITEMATTR,
MPFROM2SHORT (item, 1),
MPFROM2SHORT (MIA_CHECKED, atr));
END UnCheck;
PROCEDURE DoMenu (hwnd : HWND; item : MPARAM);
(* Processes Most Menu Interactions *)
VAR
rcl : RECTL;
rc : USHORT;
BEGIN
CASE LOWORD (item) 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, ADR (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, 0, 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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
BEGIN
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, comport, BM_SETCHECK, 1, 0);
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, comport));
RETURN 1;
| WM_CONTROL:
comport := LOWORD (mp1);
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, baudrate, BM_SETCHECK, 1, 0);
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, baudrate));
RETURN 1;
| WM_CONTROL:
baudrate := LOWORD (mp1);
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, databits, BM_SETCHECK, 1, 0);
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, databits));
RETURN 1;
| WM_CONTROL:
databits := LOWORD (mp1);
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, stopbits, BM_SETCHECK, 1, 0);
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, stopbits));
RETURN 1;
| WM_CONTROL:
stopbits := LOWORD (mp1);
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
BEGIN
WITH Settings[comport - COM_OFF] DO
CASE msg OF
WM_INITDLG:
WinSendDlgItemMsg (hwnd, parity, BM_SETCHECK, 1, 0);
WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, parity));
RETURN 1;
| WM_CONTROL:
parity := LOWORD (mp1);
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
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 : 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 (LOWORD (mp1)); (* 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 := LOWORD (mp2); (* 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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
VAR
ch : CHAR;
hps : HPS;
pswp : PSWP;
c1, c2 : CHAR;
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, 0, 0);
ELSIF (NOT TermMode) AND
(BITSET (pswp^.fs) * BITSET (SWP_MAXIMIZE) # {}) THEN
(* Prevent maximized window EXCEPT in terminal mode *)
WinPostMsg (FrameWindow, WM_SETRESTORE, 0, 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 (LOWORD (mp1))); (* 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, ADDRESS (NULL));
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 : MPARAM;
mp2 : MPARAM) : MRESULT [LONG, LOADDS];
VAR
mp : USHORT;
hps : HPS;
c1, c2 : CHAR;
BEGIN
CASE msg OF
WM_PAINT:
hps := WinBeginPaint (hwnd, NULL, ADDRESS (NULL));
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 := LOWORD (mp1);
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 TEN]
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 OS2DEF IMPORT
ULONG;
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
WinPostMsg, MPFROM2SHORT;
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;
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, 0, 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
WinPostMsg (FrameWindow, WM_TERM, MPFROM2SHORT (ORD (ch), 0), 0);
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.
[LISTING TWELVE]
() (* *) (* Copyright © 1988, 1989 *) (* by Stony Brook Software *) (* and *) (* Copyright © 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 OS2DEF IMPORT
HIWORD, LOWORD;
FROM PMWIN IMPORT
MPARAM, MPFROM2SHORT, 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;
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!!! *)
WinPostMsg (ChildFrameWindow, WM_DL,
MPFROM2SHORT (DL_BadCS, 0), 0);
RETURN FALSE;
END;
ELSE
WinPostMsg (ChildFrameWindow, WM_DL,
MPFROM2SHORT (DL_NoSOH, 0), 0);
RETURN FALSE;
END;
END ReceivePacket;
PROCEDURE DoDLMsg (mp1, mp2 : MPARAM);
(* Process DataLink Messages *)
BEGIN
CASE LOWORD (mp1) 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, 229, 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]
HEAPSIZE 16384 STACKSIZE 16384 EXPORTS
WindowProc ChildWindowProc
[FILE PCKERMIT]
OS2DEF.SYM: OS2DEF.DEF
M2 OS2DEF.DEF/OUT:OS2DEF.SYM
OS2DEF.OBJ: OS2DEF.MOD OS2DEF.SYM
M2 OS2DEF.MOD/OUT:OS2DEF.OBJ
PMWIN.SYM: PMWIN.DEF OS2DEF.SYM
M2 PMWIN.DEF/OUT:PMWIN.SYM
PMWIN.OBJ: PMWIN.MOD OS2DEF.SYM PMWIN.SYM
M2 PMWIN.MOD/OUT:PMWIN.OBJ
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 PMWIN.SYM OS2DEF.SYM
M2 SHELL.DEF/OUT:SHELL.SYM
TERM.SYM: TERM.DEF
M2 TERM.DEF/OUT:TERM.SYM
PAD.SYM: PAD.DEF PMWIN.SYM
M2 PAD.DEF/OUT:PAD.SYM
DATALINK.SYM: DATALINK.DEF PAD.SYM PMWIN.SYM
M2 DATALINK.DEF/OUT:DATALINK.SYM
PMAVIO.SYM: PMAVIO.DEF PMWIN.SYM OS2DEF.SYM
M2 PMAVIO.DEF/OUT:PMAVIO.SYM
PMAVIO.OBJ: PMAVIO.MOD PMAVIO.SYM
M2 PMAVIO.MOD/OUT:PMAVIO.OBJ
PMGPI.SYM: PMGPI.DEF OS2DEF.SYM
M2 PMGPI.DEF/OUT:PMGPI.SYM
PMGPI.OBJ: PMGPI.MOD OS2DEF.SYM PMGPI.SYM
M2 PMGPI.MOD/OUT:PMGPI.OBJ
COMMPORT.SYM: COMMPORT.DEF
M2 COMMPORT.DEF/OUT:COMMPORT.SYM
COMMPORT.OBJ: COMMPORT.MOD COMMPORT.SYM
M2 COMMPORT.MOD/OUT:COMMPORT.OBJ
FILES.SYM: FILES.DEF
M2 FILES.DEF/OUT:FILES.SYM
PCKERMIT.OBJ: PCKERMIT.MOD SHELL.SYM KH.SYM PMWIN.SYM OS2DEF.SYM
M2 PCKERMIT.MOD/OUT:PCKERMIT.OBJ
SCREEN.SYM: SCREEN.DEF PMAVIO.SYM
M2 SCREEN.DEF/OUT:SCREEN.SYM
SCREEN.OBJ: SCREEN.MOD SCREEN.SYM
M2 SCREEN.MOD/OUT:SCREEN.OBJ
FILES.OBJ: FILES.MOD FILES.SYM
M2 FILES.MOD/OUT:FILES.OBJ
SHELL.OBJ: SHELL.MOD COMMPORT.SYM KH.SYM PMGPI.SYM PMWIN.SYM PMAVIO.SYM - SCREEN.SYM DATALINK.SYM PAD.SYM TERM.SYM OS2DEF.SYM SHELL.SYM
M2 SHELL.MOD/OUT:SHELL.OBJ
TERM.OBJ: TERM.MOD COMMPORT.SYM KH.SYM SHELL.SYM PMWIN.SYM SCREEN.SYM TERM.SYM
M2 TERM.MOD/OUT:TERM.OBJ
PAD.OBJ: PAD.MOD DATALINK.SYM KH.SYM SHELL.SYM PMWIN.SYM COMMPORT.SYM - FILES.SYM OS2DEF.SYM SCREEN.SYM PAD.SYM
M2 PAD.MOD/OUT:PAD.OBJ
DATALINK.OBJ: DATALINK.MOD KH.SYM PAD.SYM COMMPORT.SYM SHELL.SYM PMWIN.SYM - OS2DEF.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: OS2DEF.OBJ PMWIN.OBJ KH.OBJ PMAVIO.OBJ PMGPI.OBJ COMMPORT.OBJ - PCKERMIT.OBJ SCREEN.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+ M2LIB+ DOSCALLS+ OS2 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 OS2DEF IMPORT
HIWORD, LOWORD;
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, MPFROM2SHORT, 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;
PROCEDURE PtrToStr (mp : 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);
UNTIL c = 0C;
END PtrToStr;
PROCEDURE DoPADMsg (mp1, mp2 : MPARAM);
(* Output messages for Packet Assembler/Disassembler *)
VAR
Message : ARRAY [0..40] OF CHAR;
BEGIN
CASE LOWORD (mp1) OF
PAD_SendPacket:
WriteString ("Sent Packet #");
WriteInt (LOWORD (mp2), 5);
WriteString (" (ID: "); WriteHex (HIWORD (mp2), 2);
WriteString ("h)");
| PAD_ResendPacket:
WriteString ("ERROR -- Resending:"); WriteLn;
WriteString (" Packet #");
WriteInt (LOWORD (mp2), 5);
WriteString (" (ID: "); WriteHex (HIWORD (mp2), 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 (LOWORD (mp2), 5);
WriteString (" (ID: "); WriteHex (HIWORD (mp2), 2);
WriteString ("h)");
| PAD_Filename:
WriteString ("Filename = ");
PtrToStr (mp2, Message); WriteString (Message);
| PAD_RequestRepeat:
WriteString ("ERROR -- Requesting Repeat:"); WriteLn;
WriteString (" Packet #");
WriteInt (LOWORD (mp2), 5);
WriteString (" (ID: "); WriteHex (HIWORD (mp2), 2);
WriteString ("h)");
| PAD_DuplicatePacket:
WriteString ("Discarding Duplicate:"); WriteLn;
WriteString (" Packet #");
WriteString (" (ID: "); WriteHex (HIWORD (mp2), 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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ProbClSrcFile, 0),
ADR (sFname));
END;
END;
END CloseInput;
PROCEDURE NormalQuit;
(* Exit from Thread, Post message to Window *)
BEGIN
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Quit, 0), 0);
DosExit (EXIT_THREAD, 0);
END NormalQuit;
PROCEDURE ErrorQuit;
(* Exit from Thread, Post message to Window *)
BEGIN
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Error, 0), 0);
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;
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Msg, 0), ADR (ErrorMsg));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_SendPacket, 0),
MPFROM2SHORT (PktNbr, sSeq));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ResendPacket, 0),
MPFROM2SHORT (PktNbr, sSeq));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Msg, 0),
ADR ("No file specified..."));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_NoSuchFile, 0),
ADR (sFname));
ErrorQuit;
ELSE
sSeq := 0; PktNbr := 0;
FlushUART;
SendInit; (* my configuration information *)
IF NOT GetInitAck() THEN (* get your configuration information *)
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
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;
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_NoSuchFile, 0),
ADR (sFname));
ErrorQuit;
END;
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Filename, 0),
ADR (sFname));
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Msg, 0),
ADR ("(<ESC> to abort file transfer.)"));
SendFileName;
IF NOT GetAck() THEN
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
CloseInput;
ErrorQuit;
END;
SendEOF;
IF NOT GetAck() THEN
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ReceivedPacket, 0),
MPFROM2SHORT (PktNbr, rSeq));
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;
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Filename, 0),
ADR (rFname));
RETURN name;
ELSIF RecOK AND (rP[3] = 'B') THEN
RETURN eot;
ELSE
INC (trys);
SendNak;
END;
END;
END ReceiveHeader;
PROCEDURE SendNak;
BEGIN
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_RequestRepeat, 0),
MPFROM2SHORT (PktNbr, rSeq));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_DuplicatePacket, 0),
MPFROM2SHORT (0, rSeq));
ELSE
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ReceivedPacket, 0),
MPFROM2SHORT (PktNbr, rSeq));
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;
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Msg, 0),
ADR ("Ready to receive file(s)..."));
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_Msg, 0),
ADR ("(<ESC> to abort file transfer.)"));
FlushUART;
rSeq := 0; PktNbr := 0;
IF NOT ReceiveInit() THEN (* your configuration information *)
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_UnableToOpen, 0),
ADR (rFname));
ErrorQuit;
ELSE
PktNbr := 1;
EOF := FALSE;
END;
| fail : WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ProbClDestFile, 0),
ADR (rFname));
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
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ErrWrtFile, 0),
ADR (rFname));
ErrorQuit;
END;
trys := 1;
SendAck (rSeq);
ELSE
INC (trys);
IF trys = MAXtrys THEN
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
ErrorQuit;
ELSE
SendNak;
END;
END;
ELSE
INC (trys);
IF trys = MAXtrys THEN
WinPostMsg (ChildFrameWindow, WM_PAD,
MPFROM2SHORT (PAD_ExcessiveErrors, 0),
MPFROM2SHORT (0, 0));
ErrorQuit;
ELSE
SendNak;
END;
END;
END;
END;
NormalQuit;
END Receive;
BEGIN (* module initialization *)
yourEOL := ASCII.cr; yourNPAD := 0; yourPADC := 0C;
END PAD.
/data/webs/external/dokuwiki/data/pages/archive/computers/anderson.txt · Last modified: 2001/11/08 10:19 by 127.0.0.1