{$R-,S-,I-,D+,T-,F-,V-,B-,N-,L+ } {$M 32768,0,131072 } Program Kermit ; (* ***************************************************************** *) (* *) (* Author - Victor Lee *) (* Queen's University , Phone *) (* Kingston, Ontario, CANADA (613)-545-2033 *) (* K7L 3N6 *) (* Comments and problems can be sent to VIC at QUCDN.BITNET *) (* or to Victor.Lee@Queens.CA *) (* *) (* Date - 1985 January *) (* - 1985 May 1 first official release *) (* Acknowlegement - *) (* Victoria Henderson - original Tek4010 coding. *) (* Contributions from Kevin Lowey, Gisbert W.Selke and *) (* special thank to many others who have reported bugs, *) (* provided fixes, and offered suggestions for improvement. *) (* *) (* Date - 1988 April Version 3.0 *) (* Version 3.0 is a major rewrite of QK-Kermit using *) (* Turbo Pascal 4.0. This version is for MsDos systems *) (* only and CP/M systems are no longer supported. *) (* Improved graphic support, Large packet size, *) (* and script commands for automated logons. *) (* Modifications *) (* 1988 May - Ack Data Packets earlier. *) (* June 29 - Fix bug in using Directory Prefixes in *) (* Sendfile. *) (* July 15 - Don't mask out bit8 if parity NONE *) (* Sept 16 - Tek4100 terminal emulation replaces *) (* the Tek4010, to enable color graphics. *) (* Sept 30 - Fix from Andy Rutherford (AGRSI@CUNYVM) *) (* to handle non-graphics Monochrome monitor. *) (* Oct 7 - Official Release of 3.1 *) (* *) (* ***************************************************************** *) (* Kermit UNITS *) (* *) (* KGLOBALS - Global variables and utility procedures *) (* GetToken *) (* UpperCase *) (* Prefixof *) (* NewAsFile *) (* SYSFUNC - These are operating system dependent procedures *) (* KeyChar *) (* CursorUp,CursorDown,CursorRight,CursorLeft *) (* Scroll,FatCursor, *) (* LocalScreen,RemoteScreen *) (* SetDefaultDrive,DefaultDrive *) (* MODEMPRO - These are Machine dependent Modem procedures *) (* InitModem,ResetModem,SetModem, *) (* AnswerModem,DialModem *) (* RecvChar,SendChar,SendBreak, *) (* CharsInBuffer,EmptyBuffer *) (* PACKETS - packet related procedures *) (* ReadChar,ReadMChar *) (* SendPacket,RecvPacket, *) (* ReSendit,SendPacketType, *) (* PutInitPacket,GetInitPacket *) (* SENDRECV - Sending and Receiving file procedures *) (* RECVFILE *) (* SENDFILE *) (* BreakAck *) (* VT100 - Terminal Emulation procedure *) (* CONNECT *) (* TEK4100 - Graphics terminal emulation procedure *) (* Tektronics *) (* SETSHOW - set and show options *) (* ShowOptions *) (* SetOptions *) (* DisplayCommands *) (* LOCAL - local procedures *) (* DisplayDir - Display directory. *) (* EraseFiles - Erase files. *) (* RenameFiles - Rename files. *) (* DisplayFile - Display file (TYPE file ). *) (* (RunFile - Run a program ( See SYSFUNC procedures ) ) *) (* DEFWORDS - Define Words procedures *) (* AssignDefWord *) (* DisplayDefWords *) (* CheckDefWords *) (* WriteDefWord *) (* DEFINEWORD *) (* LoadDefWords *) (* SaveDefWords *) (* REMOTEU - Remote request procedures *) (* RemotePro *) (* MISCCOMM - Miscellaneous command *) (* Logit - log the session to a file. *) (* Takeit - take commands from a file. *) (* QuitExit - terminate kermits and log out. *) (* DRIVERS - graphics drivers from Turbo pascal 4.0 *) (* FONTS - graphics fonts from Turbo pascal 4.0 *) (* *) (* ***************************************************************** *) uses Dos,Crt,printer,graph, (* Standard Turbo Pascal Units *) KGlobals, (* Kermit Globals *) ModemPro, Vt100,tek4100, SetShow,SendRecv,RemoteU, MiscComm,Local,Defwords ; TYPE Commandindex = ( zero, wait, connect, send, receive, setparm, status, directory, erase, rename, typefile, runfile, remote, log, take, define, help, mkdirl, rmdirl, chdirl, audio, parms, line25, quit, null ); Commandindex2= (zero2,input,output,pause,echo,clear); VAR timeout : boolean ; inbyte : byte ; Hour,hh,mm,ss,ms : word ; i,j,inlength,inputTimer,timer,alarm : integer ; inputstring, NameString : string ; command, commandtable,commandtable2,inbuff : string ; (* ***************************************************************** *) (* ******** Outter Block of Kermit ****************************** *) (* ***************************************************************** *) BEGIN (* KERMIT *) commandtable := concat('bad ', 'WAIT ', 'CONNECT ', 'SEND ', 'RECEIVE ', 'SET ', 'STATUS ', 'DIRECTORY ', 'ERASE DEL ', 'RENAME ', 'TYPE ', 'RUN EXEC ', 'REMOTE ', 'LOG ', 'TAKE ', 'DEFINE ', 'HELP ? ', 'MKDIR MD ', 'RMDIR RD ', 'CHDIR CD ', 'AUDIO ', 'PARMS ', 'LINE25 ', 'QUIT EXIT ', 'DO LOCAL ') ; commandtable2 := concat('bad2 ', 'INPUT ', 'OUTPUT ', 'PAUSE ', 'ECHO ', 'CLEAR ') ; Writeln(' * ======================================== * '); Writeln(' * Queen''s University - KERMIT /',termtype,' * '); Writeln(' * * '); Writeln(' * Version ',version,Gversion,' - ',Date,' * '); Writeln(' * Author - Victor Lee * '); Writeln(' * Graphics ',Graphics,' * '); Writeln(' * ======================================== * '); inputstring := '' ; For i := 1 to ParamCount do inputstring := inputstring + ' ' + paramstr(i) ; Running := True ; While Running Do Begin (* Command Loop *) if audioflag then Begin sound(1500);delay(50);sound(300);delay(50);nosound; end ; if length(inputstring)<1 then if TakeActive then Begin (* Get command from file *) Readln(Commandfile,inputstring); TakeActive := not Eof(commandfile); if Eof(commandfile) then close(commandfile); End else Begin (* ask for input *) Write('QK-Kermit>'); (* PROMPT for input *) readln(inputstring); End ; (* ask for input *) command := Uppercase(GETTOKEN(inputstring)); CheckDefWords(DefList,command,Inputstring); command := ' ' + command ; WaitXon := false ; case commandindex(POS(command,commandtable) div 10 ) of zero : If length(command)>1 then Begin (* check table 2 - Script commands *) case commandindex2(POS(command,commandtable2) div 10) of zero2 : Begin (* bad command *) Writeln('Invalid Command >>>>> ',Command,' <<<<<'); Writeln('--- Type HELP to see valid Commands.--- '); End ; (* bad command *) input : Begin (* Input Command *) Val(GetToken(InputString),InputTimer,j) ; i := 1 ; GetTime(hh,mm,ss,ms); Alarm := mm*60 + ss + InputTimer ; inlength := length(inputstring); timeout:=false; While (i <= inlength) and (not timeout) do If RecvChar(inbyte) then Begin (* got char *) If chr(inbyte) = InputString[i] then begin (* matches *) InBuff[i] := chr(inbyte) ; InBuff[0] := chr(i) ; i := i + 1 ; end (* matches *) else i := 1 ; write(chr(inbyte)); End (* got char *) else Begin (* time it *) GetTime(Hour,mm,ss,ms); Timer := mm*60 + ss ; If Hour<>hh then Timer := Timer + 3600 ; If Timer > Alarm then timeout := true ; End ; (* time it *) if timeout then writeln('Timed Out') ; (* else writeln(inputstring); *) inputstring := ''; End ; (* Input Command *) output : Begin (* Output Command *) For i := 1 to length(inputstring) do if inputstring[i]='~' then Sendchar(CR_) (* carriage return *) else Sendchar(ord(inputstring[i])); InputString := ''; End ; (* Output Command *) pause : Begin (* pause *) Val(GetToken(Inputstring),i,j); delay(i); End ; (* pause *) echo : Begin writeln(inputstring); inputstring := ''; end; clear : Begin (* Clear *) DialModem ; For i := 1 to 255 do Inbuff := ' '; End ; (* Clear *) end ; (* case *) End ; (* check table 2 - Script commands *) wait : Begin AnswerModem ; Connection ; End ; connect : Begin If length(inputstring) > 1 then SetOptions(inputstring); CONNECTION ; End; send : SENDFILE (inputstring); receive : RECVFILE (inputstring ); setparm : SetOptions(inputstring); status : ShowOptions ; directory: DisplayDir (inputstring); erase : EraseFiles (GetToken(inputstring)); rename : RenameFile (inputstring); typefile : DisplayFile (GetToken(inputstring)); runfile : Begin (* RunFile *) NameString := GetToken(Inputstring) ; if Pos('.',NameString) = 0 then NameString := NameString + '.EXE' ; EXEC (NameString,inputstring); Case DosError of 2: Writeln('File ',NameString,' not Found'); 5: Writeln('Acess Denied'); 8: Writeln('Insufficient Memory to load program'); 10: Writeln('Invalid Environment.'); 11: Writeln('Unable to Execute file'); end ; (* DosError Case *) inputstring := '' ; end ; (* RunFile *) remote : RemoteProc (inputstring); log : Logit (GetToken(inputstring)); take : Takeit (GetToken(inputstring)); define : DefineWord(inputstring); help : DisplayCommands ; mkdirl : Begin (* Make Directory *) NameString := GetToken(Inputstring) ; {$I-} Mkdir (NameString) ; {$I+} If IoResult = 0 then writeln('Directory ',NameString,' maked OK.') else writeln('Unable to make directory - ',NameString); End ;(* Make Directory *) chdirl : Begin (* Change Directory *) NameString := GetToken(Inputstring) ; {$I-} Chdir (NameString) ; {$I+} If IoResult = 0 then writeln('Directory changed to ',NameString) else writeln('Unable to change directory - ',NameString); End ;(* Change Directory *) rmdirl : Begin (* Remove Directory *) NameString := GetToken(Inputstring) ; {$I-} Rmdir (NameString) ; {$I+} If IoResult = 0 then writeln('Directory ',NameString,' removed. ') else writeln('Unable to remove directory - ',NameString); End ;(* Remove Directory *) audio : AudioFlag := AudioFlag xor True ; parms : ParmFlag := ParmFlag xor True ; line25 : Line25Flag := Line25Flag xor True ; quit : QuitExit (UpperCase(GetToken(inputstring))); null : ; end ; (* Case commandindex *) End ; (* Command Loop *) If Logging then Close(Logfile); If NewDefs then SaveDefWords ; If audioflag then begin sound(1500);delay(200);sound(3000);delay(200);end ; ResetModem; If audioflag then begin sound(2000);delay(200); nosound; end ; ClrScr; Gotoxy(20,10); Write( ' G O O D - B Y E '); END. (* KERMIT *)