home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
TPKERMIT
/
KERMIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-03-25
|
18KB
|
395 lines
(* +FILE+ KERMIT.PASMSCPM *)
{$C-}
Program Kermit ;
(* ***************************************************************** *)
(* *)
(* Author - Victor Lee, Queen's University, Kingston, Ontario *)
(* Comments and problem can be sent to VIC@QUCDN.BITNET *)
(* Phone - 613-547-6115 *)
(* Contributions from Jeff Duncan *)
(* Date - 1985 January *)
(* - 1985 May 1 first official release *)
(* - June 28 Add run command , fix logging *)
(* - July 5 Fix Asfile bug. *)
(* July 10 Fix Binary Transfer bug (no repeatchar) *)
(* July 17 change write(ch) to ritechar to fix bug *)
(* with keyboard input. *)
(* July 23 Add I/O error handling,fix initparm bug, *)
(* restrict source to 80 columns. *)
(* Aug 7 Use $C- option, Eliminate the use of *)
(* ritechar procedure. Add VT100 terminal *)
(* simulation code *)
(* Sept 9 Minor cleanup of code. Retry for reading *)
(* Keytable file. *)
(* Sept 18 Set version number. *)
(* Sept 30 Check seqnum on recieved data packets. *)
(* Nov. 01 Reenable auto remote command. *)
(* Dec. 16 Insert Mode ( FatCursor indicator ) *)
(* Dec. 20 Sub Directory commands and features *)
(* Dec. 23 Audio Toggle . *)
(* Date - 1986 Jan. 7 Allow Packet Parameter specifications. *)
(* Jan. 14 Apl character set selection. *)
(* Jan. 20 8bit quote and repeat char. bug fixed. *)
(* Jan. 22 Remove some of the system dependant code *)
(* from KERMIT.PAS. *)
(* Jan. 29 Break key - to us ALT F10 . *)
(* *)
(* ***************************************************************** *)
(* Utility Procedures *)
(* HEX *)
(* UpperCase *)
(* GETTOKEN *)
(* NewAsFile *)
(* SysFunc Procedures - These are operating system dependent *)
(* KeyChar *)
(* CursorPosition *)
(* CursorUp,CursorDown,CursorRight,CursorLeft *)
(* LocalScreen,RemoteScreen *)
(* FirstFile,Nextfile *)
(* DefaultDrive *)
(* SetDefaultDrive *)
(* DisplayDiskStatus *)
(* ExecFile *)
(* Modem Procedures - These are Machine dependent procedures *)
(* InitModem *)
(* SetModem *)
(* ResetModem *)
(* DialModem *)
(* RecvChar *)
(* SendChar *)
(* *)
(* Define Word Procedures *)
(* AssignDefWord *)
(* DisplayDefWords *)
(* CheckDefWords *)
(* WriteDefWord *)
(* DEFINEWORD *)
(* LoadDefWords *)
(* SaveDefWords *)
(* Read Character Procedure *)
(* ReadChar *)
(* Packet Procedures *)
(* SENDPACKET *)
(* RECVPACKET *)
(* RESENDIT *)
(* SENDACK *)
(* *)
(* ------------------ COMMAND PROCEDURES -------------------- *)
(* *)
(* SENDFILE - Sends a file to another computer. *)
(* RECVFILE - Receive a file from another computer. *)
(* CONNECTION- Simulate a dumb terminal. *)
(* SetShow Procedures *)
(* SHOWIT - Display the options . *)
(* SETIT - Set the options. *)
(* DisplayCommands - Displays the commands available. *)
(* *)
(* Local Procedures *)
(* DisplayDir - Display directory. *)
(* EraseFiles - Erase files. *)
(* RenameFiles - Rename files. *)
(* DisplayFile - Display file (TYPE file ). *)
(* (RunFile - Run a program ( See SYSFUNC procedures ) ) *)
(* *)
(* REMOTEPRO - Remote request procedures *)
(* Misccomm Procedures *)
(* Logit - log the session to a file. *)
(* Takeit - take commands from a file. *)
(* QuitExit - terminate kermits and log out. *)
(* *)
(* ***************************************************************** *)
CONST
VERSION = '2.5 ' ; (* <<<<<<<<<<<< V E R S I O N <<<<<<<<<<< *)
Date = '1986 January 29 ' ;
LocalChar = $1C ; (* control backslash ^\ *)
BreakChar = $1D ; (* control right bracket ^] *)
SOH = $01 ; (* Start of Header *)
EOT = $04 ; (* End of transmission *)
BS = $08 ; (* Back Space *)
Xon = $11 ;
Xoff = $13 ;
ESC = $1B ;
DEL = $7F ;
TYPE
layouts = (one,two,three,four,five,six,seven,eight,nine,ten) ;
Commandindex = (
zero,
connect,
send,
receive,
setparm,
status,
directory,
erase,
rename,
typefile,
runfile,
remote,
log,
take,
define,
help,
mkdir,
rmdir,
chdir,
audio,
parms,
quit,
null );
comstring = string[80] ;
Wstring = string[10] ;
STATETYPE = (S,SF,SD,SZ,SB,C,A,R,RF,RD) ;
ABORTTYPE = (NOSOH,BADSF,NOT_S,NOT_SFBZ,NOT_DZ);
BREAKTYPE = (NOBREAK,BX,BZ,BC,BE);
PACKET = PACKED ARRAY[1..255] OF BYTE ;
ParityType = (OddP,EvenP,MarkP,NoneP);
DefPointer = ^DefineRec ;
DefineRec = Record
Link : DefPointer ;
DefWord : Wstring ;
DefString : comstring ;
End ;
VAR
STATE : STATETYPE ;
ABORT : ABORTTYPE ;
BREAKSTATE : BREAKTYPE ;
RetryCount : Integer ;
(* Packet variables *) (* format *)
(* Receive Send *) (* SOH *)
InCount, OutCount : BYTE ; (* COUNT *)
INSEQ, OUTSEQ : BYTE ; (* SEQNUM *)
INPACKETTYPE, OUTPACKETTYPE : BYTE ; (* TYPE *)
RecvData, SendData : PACKET ; (* DATA... *)
CHECKSUM : INTEGER ; (* CHECKSUM *)
CRC : INTEGER ; (* CRC *)
InDataCount, OutDataCount : BYTE ; (* dataCOUNT *)
(* Initialization packet parameters *)
PacketSize,Timeout,NumPad,PadChar,EndChar,StartChar,
CntrlQuote,Bit8Quote,Checktype,RepChar : Byte ;
(* Operational Options Parameters *)
LocalEcho : Boolean ;
Series1 : Boolean ;
XonXoff : Boolean ;
BaudRate : Integer ;
Parity : ParityType ;
PrimaryPort : Boolean ;
AudioFlag,AplFlag,ParmFlag : Boolean ;
(* Execution control flags *)
WaitXon, Running, Logging, ForPrinter,
ActiveCommandFile, GotSOH,DTRcheck : Boolean ;
I : INTEGER ;
inputstring : comstring ;
command : Wstring ;
commandtable,parmtable : string[255];
LogName,dummy : comstring ;
Logfile,CommandFile : Text ;
{$I Utility.Pas }
{$I SYSFUNC.PAS }
{$I MODEMPRO.PAS }
{$I ReadChar.Pas }
{$I DefWords.pas }
{$I packet.pas }
(* ----------------------------------------------------------------- *)
(* SENDFILE - Procedure *)
(* ----------------------------------------------------------------- *)
{$I SENDFILE }
(* ----------------------------------------------------------------- *)
(* RECVFILE - Procedure *)
(* ----------------------------------------------------------------- *)
{$I RECVFILE }
(* ----------------------------------------------------------------- *)
(* Graphics - Procedures . This are only required for graphics. *)
(* ----------------------------------------------------------------- *)
{$I TYPEDEF }
{$I GRAPHIX }
{$I KERNEL }
{*I POLYGON }
{*I HATCH }
(* ----------------------------------------------------------------- *)
(* CONNECTION - Procedure *)
(* ----------------------------------------------------------------- *)
{$I CONNECT }
(* ----------------------------------------------------------------- *)
(* SHOWOPTIONS and SETOPTIONS and DisplayCommand - Procedures *)
(* ----------------------------------------------------------------- *)
{$I SETSHOW }
(* ----------------------------------------------------------------- *)
(* Local Procedures - Directory, Erase, Rename, Typefile *)
(* ----------------------------------------------------------------- *)
{$I LOCAL }
(* ----------------------------------------------------------------- *)
(* Remote Procedures *)
(* ----------------------------------------------------------------- *)
{$I REMOTE }
(* ----------------------------------------------------------------- *)
(* MiscCommands - LOG , Exit - Procedures *)
(* ----------------------------------------------------------------- *)
{$I MISCCOMM }
(* ***************************************************************** *)
(* ******** Outter Block of Kermit ****************************** *)
(* ***************************************************************** *)
BEGIN (* KERMIT *)
commandtable := concat('bad ',
'CONNECT ',
'SEND ',
'RECEIVE ',
'SET ',
'STATUS ',
'DIRECTORY ',
'ERASE ',
'RENAME ',
'TYPE ',
'RUN EXEC ',
'REMOTE ',
'LOG ',
'TAKE ',
'DEFINE ',
'HELP ? ',
'MKDIR MD ',
'RMDIR RD ',
'CHDIR CD ',
'AUDIO ',
'PARMS ',
'QUIT ',
'DO LOCAL ') ;
(* Default Packet settings *)
PacketSize := 94 ; (* PACKET size 94 maximum *)
Timeout := 60 ; (* Time out in seconds *)
NumPad := 00 ; (* Number of Pad characters *)
PadChar := 00 ; (* Padding Character *)
EndChar := 13 ; (* End of line char - CR *)
StartChar := 01 ; (* Start of Packet char - SOH *)
CntrlQuote := 35 ; (* # *)
Bit8Quote := 38 ; (* & *)
CheckType := 49 ; (* 1 *)
RepChar := 00 ; (* ~ *)
(* Default Settings *)
Baudrate := DefaultBaud ;
Parity := EvenP ;
XonXoff := False ;
Series1 := True ;
LocalEcho := False ;
PrimaryPort := True ;
AudioFlag := False ;
AplFlag := False ;
ParmFlag := False ;
(* Set control flow flags *)
connected := false ;
logging := false ;
ForPrinter := false ;
ActiveCommandfile := false ;
GotSOH := false ;
DTRcheck := true ;
Running := true;
DefList := Nil ;
LoadDefWords ; NewDefs := false ;
InitModem ;
inputstring := commandline ;
(* writeln(commandline); *)
ReadKeyTable;
Writeln(' * ======================================== * ');
Writeln(' * Queen''s University - KERMIT /',termtype,' * ');
Writeln(' * * ');
Writeln(' * Version ',version,Gversion,' - ',Date,' * ');
Writeln(' * Author - Victor Lee * ');
Writeln(' * Graphics ',Graph,' * ');
Writeln(' * ======================================== * ');
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 ActiveCommandFile then
Begin (* Get command from file *)
Readln(Commandfile,inputstring);
ActiveCommandFile := not Eof(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 (* bad command *)
Writeln(' Invalid Command >>>>> ',Command,' <<<<<');
Writeln('--- Type HELP to see valid Commands.--- ');
End ; (* bad command *)
connect : Begin
If length(inputstring) > 1 then SetOptions(inputstring);
CONNECTION ;
End;
send : SENDFILE (inputstring);
receive : RECVFILE (inputstring );
setparm : SetOptions(inputstring);
status : ShowOptions ;
directory: DisplayDir (GetToken(inputstring));
erase : EraseFiles (GetToken(inputstring));
rename : RenameFile (inputstring);
typefile : DisplayFile (GetToken(inputstring));
runfile : EXECFile (inputstring);
remote : RemoteProc (inputstring);
log : Logit (GetToken(inputstring));
take : Takeit (GetToken(inputstring));
define : DefineWord(inputstring);
help : DisplayCommands ;
mkdir : MkdirFunc (GetToken(inputstring)) ;
rmdir : RmdirFunc (GetToken(inputstring)) ;
chdir : ChdirFunc (GetToken(inputstring)) ;
audio : AudioFlag := AudioFlag xor True ;
parms : ParmFlag := ParmFlag 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 ;
If connected then 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 *)