_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 , 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 to *) 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 *) 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 *) 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 #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 ( --> )", 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 ("( 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 ("( 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.