{ File: TC.PAS } Program TurboComm; { Program's function: Test out COMMLIB.INC } { Some code has been added that will only compile under } { Turbo Pascal Version 3.0 or greater } { Search for 'Version 3.0', comment that code out, and } { un-comment out the code marked '< 3.0' } { Turn off ^C checking, to enhance speed somewhat } {$C-} Label EndProgram; Const TCVersion = '1.11'; Esc = ^[; CarrReturn = ^M; ReverseScreen = ^['[?5h'; UnreverseScreen = ^['[?5l'; SaveCursor = ^['7'; RestoreCursor = ^['8'; Bold = ^['[1m'; Off = ^['[m'; Reverse = ^['[7m'; ReverseBold = ^['[7;1m'; PrinterReady = ^['[?10n'; { Printer is turned on } PrinterNotReady = ^['[?11n'; { Printer if not turned on } TermVT102 = ^['[?6c'; TermVT125 = ^['[?12;7;0c'; TermVT220 = ^['[?62;1;2c'; TermVT240 = ^['[?62;1;2;3;4c'; DefaultTerm = TermVT220; { Set default terminal to VT220 } SendRetries = 10; { Max number of times to resend a char } VT200Keys : Boolean = True; { Use the VT2xx function key values } FileNameLen = 62; { Turbo Pascal Version 3.0 Only } { i.e. It supports pathnames } { FileNameLen = 14; { Turbo Pascal Version < 3.0 } Type STR80 = String[80]; StringLong = String[150]; Var DummyLogical : Boolean; Counter, Counter2, CurrentBaud, CtrlCCheck : Integer; TermID : STR80; { String returned on host after Terminal ID request } FileOpen : Boolean; ReGISOn : Boolean; { Are we running the Poly-ReGIS emulator? } DisplayOn : Boolean; { Output to screen? } PrinterOn : Boolean; { Output to printer? } LoggingOn : Boolean; { Output to file? } FileVar : Text; { File type for sending or receiving } Filename : String[FileNameLen]; CursorRow, CursorCol : Integer; { Supplied by GetCursorPosition } { These are the different data registers used for MSDOS interrupts } Type __Regs = Record case Integer of 1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : INTEGER); 2: (AL,AH,BL,BH,CL,CH,DL,DH : Byte); end; Var __Registers : __Regs; __SaveRegisters : __Regs; { Use this to save the initial reg values } {$I FUNKEY.INC } { Include function key input definiton } Procedure WriteStatus(OutputString : StringLong); { Get current cursor position, write status on bottom of screen, return to previous cursor position } Begin Write(SaveCursor); { Save cursor position } GotoXY(1,24); ClrEol; Write(OutputString); Write(RestoreCursor); { Restore cursor position } End; { Procedure WriteStatus } Procedure SetCtrlCCheck; { Read startup value of Control-C checking, set off, save value } { N.B. This is the equivalent of the MS-DOS BREAK=OFF command } { and is required to run this program. } Begin { Get initial value and save to variable } __Registers.AH := $33; __Registers.AL := 0; Intr($21,__Registers); CtrlCCheck := __Registers.DL; { Set checking off } __Registers.AH := $33; __Registers.AL := 1; __Registers.DL := 0; Intr($21,__Registers); End; { Procedure SetCtrlCCheck } Procedure ResetCtrlCCheck; { Reset the original Control C checking value to startup value } { See previous procedure for explaination. } Begin __Registers.AH := $33; __Registers.AL := 1; __Registers.DL := CtrlCCheck; Intr($21,__Registers); End; { Procedure ResetCtrlCCheck } Function CheckPrinter : Boolean; { Check the status of the printer port } Begin If Port[$43] = 100 Then CheckPrinter := True Else CheckPrinter := False; End; { Function CheckPrinter } Procedure CheckFunctionStatus(FunctionStatus : Boolean; FunctionName : STR80); { Check the status of a function's value, and print on error, given the name of the function that was called. } Var OutputLine : STR80; Begin If Not FunctionStatus Then Begin OutputLine := Bold+FunctionName+' not successful.'+Off; WriteStatus(OutputLine); End { If file not opened } End; { Procedure CheckFunctionStatus } {$I COMMLIB.INC } { Include communications function definitions } {$I CHECKESC.INC } { Check all escape sequences for specials } {$I GETVIDLN.INC } { Read video memory for screen line } {$I REDEFINE.INC } { Include function key redefinition routines } Procedure PrintScreen; { Read the current screen from video memory, and dump to printer } { N.B. If ReGIS is running, let it handle print screens itself } Var VidChar : Char; LineCounter, ColCounter : Integer; VideoString,DummyString : StringLong; LineDrawingOn : Boolean; Begin If CheckPrinter And (Not ReGISOn) { The printer is ready } Then { and we're not running ReGIS } Begin { First set up video screen width by getting a line twice } DummyString := GetVidLine(1); DummyString := GetVidLine(1); { Now set printer width according to screen width } If VideoScreenWidth = 132 Then Write(Lst,^[,'[4w') Else Write(Lst,^[,'[0w'); LineDrawingOn := False; Write(Lst,^O); { Turn printer graphics off } { Now get all the screen lines and print them } Write(ReverseScreen); { Reverse the screen until done } For LineCounter := 1 to 24 Do Begin VideoString := GetVidLine(Linecounter); { Get line } { Move source code left, because of length of lines } For ColCounter := 1 to Length(VideoString) Do Begin { Checking and printing character } VidChar := VideoString[ColCounter]; If Ord(VidChar) < 32 Then { We've got a graphics character to print } If LineDrawingOn Then Write(Lst,Chr(Ord(VidChar) + 95)) Else Begin Write(Lst,^N); { Printer to graphics mode } Write(Lst,Chr(Ord(VidChar) + 95)); LineDrawingOn := True; End { We had to turn on graphics mode } Else If Not LineDrawingOn Then Write(Lst,VidChar) { normal character } Else Begin Write(Lst,^O); Write(Lst,VidChar); LineDrawingOn := False; End; { We had to turn off graphics & print } End; { FOR ColCounter loop to print video line } Writeln(Lst); { Send a carriage return, line feed to printer } Delay(2); { Give it a short rest } End; { FOR LineCounter loop to print video line } Write(UnReverseScreen); Write(Lst,^O); { Always turn line drawing off when done } End; End; { Procedure PrintScreen } { Const { Turbo Pascal Version < 3.0 } { ParamStrArray : Array[1..5] of STR80 = ('','','','',''); { nulls } { Var { Turbo Pascal Version < 3.0 } { ParamCount : Byte; { Procedure ParseCmdLine; { Turbo Pascal Version < 3.0 } { Read any user command line, and return it as a string } { This loads the array ParamStrArray } { Var CL : STR80 absolute cseg:$80; CLCopy : STR80; begin ParamCount := 0; CLCopy := CL; While CLCopy > '' Do Begin While CLCopy[1] = ' ' Do CLCopy := Copy(CLCopy,2,Length(CLCopy) - 1); ParamCount := ParamCount + 1; While (CLCopy[1] <> ' ') And (CLCopy > '') Do Begin ParamStrArray[ParamCount] := ParamStrArray[ParamCount] + CLCopy[1]; CLCopy := Copy(CLCopy,2,Length(CLCopy) - 1); End; { While the next char isn't a space } { End; { While there are more characters to get } { end; { Procedure ParseCmdLine } { Function ParamStr(I : Byte) : STR80; { Turbo Pascal Version < 3.0 } { Given the index number, return the parameter string from the array } { Begin ParamStr := ParamStrArray[I]; End; { Function ParamStr } Function DisplayMenu : Boolean; { Check command line for 'T' --> go directly to terminal emulation } { (i.e. don't display opening menu } { Also check for initial baud rate setting } Type ValidBaudType = Array [1..8] of String[4]; Const NumBauds = 8; ValidBaud : ValidBaudType = ('110','150','300', '600','1200','2400', '4800','9600'); Var Counter,BaudIndex : Integer; TempStr : STR80; Begin DisplayMenu := True; CurrentBaud := DefaultBaud; VT200Keys := True; { Read through command line for valid input parameters } For Counter := 1 to ParamCount Do Begin TempStr := ParamStr(Counter); If UpCase(TempStr[1]) = 'T' Then DisplayMenu := False Else If (TempStr = 'VT100') Or (TempStr = 'vt100') Then VT200Keys := False Else If TempStr[1] = '@' Then KeyFileName := Copy(TempStr,2,80) Else { Compare ParamStr against valid baud rates } For BaudIndex := 1 to NumBauds Do If TempStr = ValidBaud[BaudIndex] Then Val(TempStr,CurrentBaud,Counter2); End; { For Counter loop } End; { Function DisplayMenu } Function MSDosVersion : Real; { Return the current MS-DOS version number } begin __Registers.AX := $3000; MSDos( __Registers ); MSDosVersion := __Registers.AL + __Registers.AH/100; end; { Function MSDosVersion } Procedure WriteScr(Var CharToPrint : Char); { Write a character to the screen } { This could be replaced by the standard Write statement, but } { it runs about 5 percent faster. } { Save and restore the values of the registers } Begin __SaveRegisters := __Registers; With __Registers Do Begin CX := 0; DI := 0; { Function code for Console Out } AL := Ord(CharToPrint); End; Intr(24,__Registers); __Registers := __SaveRegisters; End; { Procedure WriteScr } Procedure DisplayHelp; { Display help text on the screen } Var OutputLine : StringLong; OldVideoLine : StringLong; { Old value of 24th line Declaration } Begin OutputLine := Off+'Press '+Bold+''+Off+ ' for command mode: '+Bold+ 'C'+Off+'lose '+Bold+ 'D'+Off+'isconnect '+Bold+ 'P'+Off+'rinter '+Bold+ 'Q'+Off+'uit '+Bold+ 'R'+Off+'eceive '+Bold+ 'S'+Off+'end '+ 'e'+Bold+'X'+Off+'it'; OldVideoLine := GetVidLine(24); { Old value of 24th line assignment } WriteStatus(OutputLine); Delay(8000); Write(OldVideoLine); { Restore old value of 24th line } End; { Procedure DisplayHelp } Procedure InitTermID; { Initialize the global variable TermID, based on whether we're running ReGIS emulation software or operating in normal mode. } Var InputString : STR80; Begin TermID := DefaultTerm; { Default: I am a VT220 terminal } ReGISOn := False; InputString := ''; Write(Esc,'PpR(p)',Esc,'\'); { Send out ReGIS report request } { ReGIS should return something like '[0,0]'. If ReGIS isn't on, } { nothing should be returned. So just check for the standard chars } For Counter := 1 to 50 Do If ReadKey Then InputString := InputString + InString; If Pos(']',InputString) > 0 Then Begin ReGISOn := True; If VT200Keys Then { Graphics and VT200 Class } TermID := TermVT240 Else { Graphics and VT100 Class } TermID := TermVT125; End Else Begin ReGISOn := False; If VT200Keys Then { No Graphics and VT200 Class } TermID := TermVT220 Else { No Graphics and VT100 Class } TermID := TermVT102; End; ClrScr; End; Function Space(X : Byte) : STR80; { BASIC-like function to return x number of spaces } Var TempString : STR80; Counter : Integer; Begin TempString := ''; For Counter := 1 to X Do TempString := TempString + ' '; Space := TempString; End; { Function Space } Function MoveLeft(X : Integer) : STR80; { Move the cursor left X number of positions } Var TempString : STR80; Begin Str(X,TempString); MoveLeft := ^[ + '[' + TempString + 'D'; End; { Function MoveLeft } Procedure CloseFile; { When done receiving text file, close it } Var OldVideoLine : StringLong; { Old value of 24th line Declaration } Begin If FileOpen Then Begin Write(SaveCursor); Close(FileVar); OldVideoLine := GetVidLine(24); GotoXY(1,24); ClrEol; NormVideo; Write('Closing any open files'); LowVideo; Delay(1000); GotoXY(1,24); ClrEol; Write(OldVideoLine); { Restore old value of 24th line } Write(RestoreCursor); FileOpen := False; LoggingOn := False; End; End; { Procedure CloseFile } Procedure SendFile; { Send a text file from disk via comm line } Var Line : StringLong; OldVideoLine : StringLong; { Old value of 24th line Declaration } Counter : Byte; Begin { First check that a file isn't already open } If FileOpen Then Begin CloseFile; FileOpen := False; End; { If they had :Nþté4ý¡dâ‹fâ-P