OS/2 Shareware BBS: 3 Comm

home *** CD-ROM | disk | FTP | other *** search

/ OS/2 Shareware BBS: 3 Comm / 03-Comm.zip / DDJKRMIT.ZIP / ANDERSON.ASC next >

Wrap

Text File | 1990-08-08 | 130KB | 4,077 lines

_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 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 (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 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.