home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
vmspascal
/
vxpar.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
27KB
|
1,110 lines
{ Determine length of string. }
function LenString(var tempStr : string80) : integer;
var
i : integer;
endofstring : boolean;
begin
i := 80;
endofstring := false;
while ((i >= 1) and not(endofstring)) do
if (tempStr[i] = ' ') then
i := i - 1
else
endofstring := true;
LenString := i;
end;
{ Copy command line into temporary string until either EOS or blank }
procedure SkipBlanks(var command : string80;
var commandLen : integer);
var
i, k, j, oldComLen : integer;
endOfString : boolean;
begin
i := 1;
endofString := false;
oldComLen := commandLen;
while ((i <= commandLen) and (not(endofString))) do
if (command[i] = ' ') then
i := i + 1
else
endofString := true;
k := 1;
for j:=i to commandLen do
begin
command[k] := command[j];
k := k + 1;
end;
if ((oldComLen = 1) and (i <> 1)) then
commandLen := commandLen - i
else
commandLen := commandLen - (i-1);
end;
{ Copy command line into temporary string until either EOS or blank }
procedure CopyToken(var command : string80;
var commandLen : integer;
var tempStr : string13;
var totChars : integer);
const
%include 'kermdir:pglobal.pas/nolist'
var
i, j, k : integer;
noBlank : boolean;
tempToken : string80;
begin
for i:=1 to SMALLSIZE do
tempStr[i] := ' ';
i := 1;
noblank := true;
while ((i <= commandLen) and (noblank)) do
if (command[i] <> ' ') then
begin
tempToken[i] := command[i];
i := i + 1;
end
else
noBlank := false;
totChars := i - 1;
if (totChars <= SMALLSIZE) then
for i:=1 to totChars do
tempStr[i] := tempToken[i]
else
begin
totChars := 2;
tempStr := cBADTOKEN;
end;
k := 1;
for j:=(totChars+1) to commandLen do
begin
command[k] := command[j];
k := k + 1;
end;
commandLen := commandLen - totChars;
end;
{ Routine to compare strings for symbol comparison. }
function CompareStr(command, symbol : string13;
commandLen, symbolLen : integer) : boolean;
var
i : integer;
sameStr : boolean;
begin
sameStr := true;
i := 1;
while (sameStr and (i <= commandLen)) do
if command[i] <> symbol[i] then
sameStr := false
else
i := i + 1;
i := i - 1;
CompareStr := sameStr and (i >= symbolLen);
end;
procedure StrUpcase(var command : string80;
commandLen : integer);
var
i, diff : integer;
begin
diff := ord('a') - ord('A');
for i:=1 to commandLen do
if ((command[i] >= 'a') and (command[i] <= 'z')) then
command[i] := chr(ord(command[i]) - diff);
end;
function IsNumeric( token : string13;
var tokLen, value : integer;
typeToken : integer) : boolean;
const
%include 'kermdir:pglobal.pas/nolist'
var
goodChar : boolean;
upBound : char;
base, i : integer;
begin
value := 0;
i := 1;
goodChar := true;
upBound := '9';
base := 10;
if (typeToken = OCTAL) then
begin
upBound := '7';
base := 8;
end;
while ((i <= tokLen) and (goodChar)) do
if ((token[i] >= '0') and (token[i] <= upBound)) then
begin
value := (value*base) + (ord(token[i]) - ord('0'));
i := i + 1;
end
else
begin
goodChar := false;
value := 0;
end;
goodChar := goodChar and (tokLen > 0);
if (typeToken = OCTAL) then
IsNumeric := goodChar and ((value >= 0) and (value <= 31))
else if (typeToken = SDECIMAL) then
IsNumeric := goodChar and ((value >= MINPACKETSIZE) and
(value <= MAXPACKETSIZE))
else if (typeToken = IDECIMAL) then
IsNumeric := goodChar and ((value = o300BAUD) or (value = o600BAUD) or
(value = o1200BAUD) or (value = o2400BAUD) or
(value = o4800BAUD) or (value = o9600BAUD))
else
IsNumeric := goodChar and ((value >= 0) and
(value <= 99))
end;
{ Print the ? help message for main menu. }
procedure PrintMainHelp;
begin
writeln(' send <filename or filegroup>');
writeln(' receive [<filename>]');
writeln(' status');
writeln(' connect');
writeln(' set <option>');
writeln(' show <option>');
writeln(' dcl [<vms command>]');
writeln(' help');
writeln(' exit | quit');
writeln(' ?');
end;
{ Print the ? help message for send/receive command}
procedure PrintSendReceiveHelp;
begin
writeln(' <filename or filegroup>');
end;
{ Print the ? help message for set menu. }
procedure PrintSetHelp;
begin
writeln(' send <option>');
writeln(' receive <option>');
writeln(' transmode <ASCII | binary>');
writeln(' eight-quote <c>');
writeln(' filerecord <CLF | lf | cr>');
writeln(' local-echo <on | OFF>');
writeln(' parity <NONE | even | odd>');
writeln(' debugging <on | OFF>');
writeln(' speed <d>');
writeln(' delay <d>');
writeln(' ?');
end;
{ Print the ? help message for show menu. }
procedure PrintShowHelp;
begin
writeln(' send <option>');
writeln(' receive <option>');
writeln(' transmode');
writeln(' eight-quote');
writeln(' filerecord');
writeln(' local-echo');
writeln(' debugging');
writeln(' speed');
writeln(' delay');
writeln(' all');
writeln(' ?');
end;
{ Print the ? help message for set send/receive menu. }
procedure PrintSetSendReceiveHelp;
begin
writeln(' packet-length <d>');
writeln(' padding <d>');
writeln(' padchar <o>');
writeln(' timeout <d>');
writeln(' end-of-line <o>');
writeln(' quote <c>');
end;
{ Print the ? help message for show send/receive menu. }
procedure PrintShowSendReceiveHelp;
begin
writeln(' packet-length');
writeln(' padding');
writeln(' padchar');
writeln(' timeout');
writeln(' end-of-line');
writeln(' quote');
end;
procedure PrintStatus;
{ Print the status of the last send/receive. }
const
STRWIDTH = 7;
var
overHead, effectiveRate : integer;
begin
writeln(' Packets Sent = ', NumSendPacks : STRWIDTH);
if (oldRunType = Transmit) then
begin
writeln(' Number of ACK packets = ', NumACKrecv : STRWIDTH);
writeln(' Number of NAK packets = ', NumNAKrecv : STRWIDTH);
writeln(' Number of BAD packets = ', NumBADrecv : STRWIDTH);
end
else
begin
writeln(' Number of ACK packets = ', NumACK : STRWIDTH);
writeln(' Number of NAK packets = ', NumNAK : STRWIDTH);
end;
writeln(' Data characters Sent = ', ChInFileSend : STRWIDTH);
writeln(' Total characters Sent = ', ChInPackSend : STRWIDTH);
OverHd(ChInPackSend, ChInFileSend, overHead);
writeln(' Overhead on Send Packets = ', overHead : STRWIDTH, ' %');
writeln(' ');
writeln(' Packets Received = ', NumRecvPacks : STRWIDTH);
writeln(' Data characters Received = ', ChInFileRecv : STRWIDTH);
writeln(' Total characters Received = ', ChInPackRecv : STRWIDTH);
OverHd(ChInPackRecv, ChInFileRecv, overHead);
writeln(' Overhead on Receive Packets = ', overHead : STRWIDTH, ' %');
writeln;
writeln(' Run Time = ', RunTime : STRWIDTH);
if (oldRunType = Transmit) then
CalRat(ChInFileSend, RunTime-Delay, effectiveRate)
else
CalRat(ChInFileRecv, RunTime, effectiveRate);
writeln(' Effective Baud Rate = ', effectiveRate : STRWIDTH);
end;
{ Print the message specified. }
procedure PrintMessage(messageNumber : integer);
const
%include 'kermdir:pglobal.pas/nolist'
begin
case messageNumber of
NOTIMPLEMENTED :
writeln(' ? Not Implemented');
INVALIDCOMMAND :
writeln(' ? Invalid command');
INVALIDSETCOMMAND :
writeln(' ? Invalid set command');
INVALIDSHOWCOMMAND :
writeln(' ? Invalid show command');
INVALIDFILESPEC :
writeln(' ? Invalid file specification');
INVALIDSETCVALUE :
writeln(' ? Bad value: character');
INVALIDSETDVALUE :
writeln(' ? Bad value: decimal');
INVALIDSETOVALUE :
writeln(' ? Bad value: octal');
INVALIDSETRANGE :
writeln(' ? Value not in accepted range');
NOHELPAVAILABLE :
writeln(' ? Help file does not exist');
DCLSPAWNFAILED :
writeln(' ? DCL spawn failed');
SENDPARMS :
writeln('Send Parameters:');
RECEIVEPARMS :
writeln('Receive Parameters:');
LOCALPARMS :
writeln('Local System Parameters:');
BLANKLINE :
writeln(' ');
end;
end;
procedure ExecShell(dclcommd : string80;
commdLen : integer);
{ Call the dcl shell }
const
SPAWN = 'SPAWN';
BLANK = ' ';
MAXCOMMD = 60;
var
status, i : integer;
shellLine : varying [80] of char;
begin
SetUpExitHandlerVMS(1, 4); { Lower process priority }
shellLine := ' ';
if ((commdLen - 1) > 0) then
begin
for i:=1 to commdLen do
if i < MAXCOMMD then
shellLine := shellLine + dclcommd[i];
end
else
shellLine := SPAWN;
status := $Enable_ctrl(ctrlOff);
status := $Spawn(shellLine);
if (status <> SS$_NORMAL) then
PrintMessage(DCLSPAWNFAILED)
else
writeln;
status := $Disable_ctrl(ctrlOff);
SetUpExitHandlerVMS(1, 6); { Raise process priority }
end;
{ Routine to type the help file. }
procedure PrintHelpVMS;
const
%include 'kermdir:pglobal.pas/nolist'
SCREENSIZE = 24;
var
info : varying[160] of char;
i : integer;
ch : char;
begin
open(FILE_VARIABLE := helpFile,
FILE_NAME := KERMITHELP,
HISTORY := OLD,
ERROR := CONTINUE);
if (status(helpFile) = 0) then
begin
reset(helpFile);
i := 1;
while (not(eof(helpFile))) do
begin
readln(helpFile, info);
writeln(info);
i := i + 1;
if ((i mod SCREENSIZE) = 0) then
begin
i := 1;
write('< Press RETURN to continue >');
read(ch);
end;
end;
close(helpFile);
end
else
PrintMessage(NOHELPAVAILABLE);
end;
{ Routine to print parameter values. }
procedure PrintParmValue(value, token : integer);
const
%include 'kermdir:pglobal.pas/nolist'
begin
case token of
oPACKETLENGTH :
writeln(' Packet-Length = ', value : 2, ' (dec)');
oPADDING :
writeln(' Padding = ', value : 2, ' (dec)');
oPADCHAR :
writeln(' Padding Character = ', OCT (value, 2), ' (oct)');
oTIMEOUT :
writeln(' Time-out length = ', value : 2, ' (sec)');
oENDOFLINE :
writeln(' End of Line Character = ', OCT (value, 2), ' (oct)');
oQUOTE :
writeln(' Quote Character = ', chr(value));
oTRANSMODE :
begin
write(' File Transfer Type = ');
if (value = oASCII) then
writeln('ascii')
else
writeln('binary');
end;
oEIGHTQUOTE :
writeln(' Eight-Bit Quote = ', chr(value));
oFILERECORD :
begin
write(' End of Line for file = ');
if (value = oCR) then
writeln('cr')
else if (value = oLF) then
writeln('lf')
else
writeln('cr/lf');
end;
oLOCALECHO :
begin
write(' Local Echo = ');
if (value = oOFF) then
writeln('off')
else
writeln('on');
end;
oDELAY :
writeln(' Delay = ', value : 2, ' (sec)');
oDEBUGGING :
begin
write(' Debugging = ');
if (value = oOFF) then
writeln('off')
else
writeln('on');
end;
oPARITY :
begin
write(' Parity = ');
if (value = oEVEN) then
writeln('even')
else if (value = oODD) then
writeln('odd')
else
writeln('none');
end;
oSPEED :
writeln(' Line Speed = ', lSpeed : 4);
end;
end;
{ Routine to scan for an appropriate value }
procedure ScanForValue(var command : string80;
var commandLen, value : integer;
convertType, commandType : integer);
const
%include 'kermdir:pglobal.pas/nolist'
var
tempToken : string13;
totChars : integer;
badvalue : boolean;
begin
CopyToken(command, commandLen, tempToken, totChars);
case convertType of
DECIMAL ,
SDECIMAL,
IDECIMAL :
if not(IsNumeric(tempToken, totChars, value, convertType)) and
(commandType <> oSHOWTYPE) then
begin
PrintMessage(INVALIDSETDVALUE);
value := RANGENULL;
end;
OCTAL :
if not(IsNumeric(tempToken, totChars, value, convertType)) and
(commandType <> oSHOWTYPE) then
begin
PrintMessage(INVALIDSETOVALUE);
value := RANGENULL;
end;
CHRACTER :
if (totChars = 1) then
value := ord(tempToken[1])
else if (commandType <> oSHOWTYPE) then
begin
PrintMessage(INVALIDSETCVALUE);
value := RANGENULL;
end;
EBCHRACTER :
begin
if (totChars = 1) then
begin
value := ord(tempToken[1]);
badvalue := false;
if (not(value in [EXMARK..RABRACK, GRAVE..TILDE])) then
badvalue := true;
end
else
badvalue := true;
if ((commandType <> oSHOWTYPE) and (badvalue)) then
begin
PrintMessage(INVALIDSETCVALUE);
value := RANGENULL;
end;
end;
end;
end;
{ Determine if we have a valid number, and if so set it. }
procedure TestAndSetValue(var value, numberToSet : integer;
token, commandType : integer);
const
%include 'kermdir:pglobal.pas/nolist'
begin
if (commandType = oSHOWTYPE) then
PrintParmValue(numberToSet, token)
else if (value = NULLTOKE) then
begin
PrintMessage(INVALIDSETCOMMAND);
end
else if (value <> RANGENULL) then
numberToSet := value;
end;
{ Routine to print the value of all parameters in program. }
procedure PrintAllParameters;
const
%include 'kermdir:pglobal.pas/nolist'
begin
PrintMessage(SENDPARMS);
PrintParmValue(SizeSend, oPACKETLENGTH);
PrintParmValue(Pad, oPADDING);
PrintParmValue(PadChar, oPADCHAR);
PrintParmValue(TheirTimeOut, oTIMEOUT);
PrintParmValue(SendEOL, oENDOFLINE);
PrintParmValue(SendQuote, oQUOTE);
PrintMessage(RECEIVEPARMS);
PrintParmValue(SizeRecv, oPACKETLENGTH);
PrintParmValue(MyPad, oPADDING);
PrintParmValue(MyPadChar, oPADCHAR);
PrintParmValue(MyTimeOut, oTIMEOUT);
PrintParmValue(MyEOL, oENDOFLINE);
PrintParmValue(MyQuote, oQUOTE);
PrintMessage(LOCALPARMS);
PrintParmValue(transtype, oTRANSMODE);
PrintParmValue(EBQChar, oEIGHTQUOTE);
PrintParmValue(fileEol, oFILERECORD);
PrintParmValue(localEcho, oLOCALECHO);
PrintParmValue(parity, oPARITY);
PrintParmValue(lSpeed, oSPEED);
PrintParmValue(Delay, oDELAY);
PrintParmValue(debugging, oDEBUGGING);
end;
{ Routine to parse send/receive command for file name or wildcard des. }
procedure ParseSendReceiveCommand(var commandLine : string80;
var commandLen : integer;
var tempFile : string80;
var token : integer);
const
%include 'kermdir:pglobal.pas/nolist'
var
i : integer;
begin
for i:=1 to CONLENGTH do
tempFile[i] := ' ';
if ((commandLine[1] <> ' ') and (commandLen > 0)) then
begin
if (commandLen > CONLENGTH) then
commandLen := CONLENGTH;
for i := 1 to commandLen do
tempFile[i] := commandLine[i];
if (commandLine[1] = '?') then
begin
PrintSendReceiveHelp;
token := oXXXX;
end
else
case token of
oSEND :
sFileSpec := oON;
otherwise
rFileSpec := oON;
end;
end
else
begin
case token of
oSEND :
begin
sFileSpec := oOFF;
PrintMessage(INVALIDFILESPEC);
end
otherwise
rFileSpec := oOFF;
end;
end;
end;
{ Get a valid token form the command line and return it. }
procedure ScanForToken(var commandLine : string80;
var commandLen, token : integer;
typeToken : integer);
const
%include 'kermdir:pglobal.pas/nolist'
var
tempToken : string13;
totChars : integer;
begin
CopyToken(commandLine, commandLen, tempToken, totChars);
SkipBlanks(commandLine, commandLen);
token := NULLTOKE;
if (totChars <> 0) then
case typeToken of
oMAINTYPE :
if (CompareStr(tempToken, cSET, totChars, uSET)) then
token := oSET
else if (CompareStr(tempToken, cSHOW, totChars, uSHOW)) then
token := oSHOW
else if (CompareStr(tempToken, cSTATUS, totChars, uSTATUS)) then
token := oSTATUS
else if (CompareStr(tempToken, cCONNECT, totChars, uCONNECT)) then
token := oCONNECT
else if (CompareStr(tempToken, cSEND, totChars, uMSEND)) then
token := oSEND
else if (CompareStr(tempToken, cRECEIVE, totChars, uMRECEIVE)) then
token := oRECEIVE
else if (CompareStr(tempToken, cDCL, totChars, uDCL)) then
token := oDCL
else if (CompareStr(tempToken, cHELP, totChars, uHELP)) then
token := oHELP
else if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
token := oQUESTIONM
else if (CompareStr(tempToken, cQUIT, totChars, uQUIT)) then
token := oQUIT
else if (CompareStr(tempToken, cEXIT, totChars, uEXIT)) then
token := oEXIT;
oSETTYPE,
oSHOWTYPE :
if (CompareStr(tempToken, cSEND, totChars, uSEND)) then
token := oSEND
else if (CompareStr(tempToken, cRECEIVE, totChars, uRECEIVE)) then
token := oRECEIVE
else if (CompareStr(tempToken, cTRANSMODE, totChars, uTRANSMODE)) then
token := oTRANSMODE
else if (CompareStr(tempToken, cEIGHTQUOTE, totChars, uEIGHTQUOTE)) then
token := oEIGHTQUOTE
else if (CompareStr(tempToken, cDEBUGGING, totChars, uDEBUGGING)) then
token := oDEBUGGING
else if (CompareStr(tempToken, cFILERECORD, totChars, uFILERECORD)) then
token := oFILERECORD
else if (CompareStr(tempToken, cLOCALECHO, totChars, uLOCALECHO)) then
token := oLOCALECHO
else if (CompareStr(tempToken, cDELAY, totChars, uDELAY)) then
token := oDELAY
else if (CompareStr(tempToken, cPARITY, totChars, uPARITY)) then
token := oPARITY
else if (CompareStr(temptoken, cSPEED, totChars, uSPEED)) then
token := oSPEED
else if (CompareStr(tempToken, cALL, totChars, uALL)) then
token := oALL
else if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
token := oQUESTIONM;
oSENDTYPE,
oRECEIVETYPE :
if (CompareStr(tempToken, cPACKETLENGTH, totChars, uPACKETLENGTH)) then
token := oPACKETLENGTH
else if (CompareStr(tempToken, cPADDING, totChars, uPADDING)) then
token := oPADDING
else if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
token := oQUESTIONM
else if (CompareStr(tempToken, cPADCHAR, totChars, uPADCHAR)) then
token := oPADCHAR
else if (CompareStr(tempToken, cTIMEOUT, totChars, uTIMEOUT)) then
token := oTIMEOUT
else if (CompareStr(tempToken, cENDOFLINE, totChars, uENDOFLINE)) then
token := oENDOFLINE
else if (CompareStr(tempToken, cQUOTE, totChars, uQUOTE)) then
token := oQUOTE;
oTRANSTYPE :
if (CompareStr(tempToken, cASCII, totChars, uASCII)) then
token := oASCII
else if (CompareStr(tempToken, cBINARY, totChars, uBINARY)) then
token := oBINARY;
oDEBUGTYPE,
oLOCECHOTYPE :
if (CompareStr(tempToken, cON, totChars, uON)) then
token := oON
else if (CompareStr(tempToken, cOFF, totChars, uOFF)) then
token := oOFF;
oFILERECTYPE :
if (CompareStr(tempToken, cCR, totChars, uCR)) then
token := oCR
else if (CompareStr(tempToken, cLF, totChars, uLF)) then
token := oLF
else if (CompareStr(tempToken, cCLF, totChars, uCLF)) then
token := oCLF;
oPARITYTYPE :
if (CompareStr(tempToken, cEVEN, totChars, uEVEN)) then
token := oEVEN
else if (CompareStr(tempToken, cODD, totChars, uODD)) then
token := oODD
else if (CompareStr(tempToken, cNONE, totChars, uNONE)) then
token := oNONE;
end;
end;
{ Parse the set and show command and the proceed to set appropriate
kermit variables. }
procedure ParseSetShowCommand(var commandLine : string80;
var commandLen : integer;
commandType : integer);
const
%include 'kermdir:pglobal.pas/nolist'
var
token, value : integer;
begin
ScanForToken(commandLine, commandLen, token, commandType);
case token of
oSEND :
begin
ScanForToken(commandLine, commandLen, token, oSENDTYPE);
case token of
oPACKETLENGTH :
begin
ScanForValue(commandLine, commandLen, value,
SDECIMAL, commandType);
TestAndSetValue(value, SizeSend, token,
commandType);
end;
oPADDING :
begin
ScanForValue(commandLine, commandLen, value,
DECIMAL, commandType);
TestAndSetValue(value, Pad, token, commandType);
end;
oPADCHAR :
begin
ScanForValue(commandLine, commandLen, value,
OCTAL, commandType);
TestAndSetValue(value, PadChar, token,
commandType);
end;
oTIMEOUT :
begin
ScanForValue(commandLine, commandLen, value,
DECIMAL, commandType);
TestAndSetValue(value, TheirTimeOut, token,
commandType);
end;
oENDOFLINE :
begin
ScanForValue(commandLine, commandLen, value,
OCTAL, commandType);
TestAndSetValue(value, SendEol, token,
commandType);
end;
oQUOTE :
begin
ScanForValue(commandLine, commandLen, value,
CHRACTER, commandType);
TestAndSetValue(value, SendQuote, token,
commandType);
end;
oQUESTIONM :
if (commandType = oSETTYPE) then
PrintSetSendReceiveHelp
else
PrintShowSendReceiveHelp;
otherwise
if (commandType = oSETTYPE) then
PrintMessage(INVALIDSETCOMMAND)
else
PrintMessage(INVALIDSHOWCOMMAND);
end;
end;
oRECEIVE :
begin
ScanForToken(commandLine, commandLen, token, oRECEIVETYPE);
case token of
oPACKETLENGTH :
begin
ScanForValue(commandLine, commandLen, value,
SDECIMAL, commandType);
TestAndSetValue(value, SizeRecv, token,
commandType);
end;
oPADDING :
begin
ScanForValue(commandLine, commandLen, value,
DECIMAL, commandType);
TestAndSetValue(value, MyPad, token, commandType);
end;
oPADCHAR :
begin
ScanForValue(commandLine, commandLen, value,
OCTAL, commandType);
TestAndSetValue(value, MyPadChar, token,
commandType);
end;
oTIMEOUT :
begin
ScanForValue(commandLine, commandLen, value,
DECIMAL, commandType);
TestAndSetValue(value, MyTimeOut, token,
commandType);
end;
oENDOFLINE :
begin
ScanForValue(commandLine, commandLen, value,
OCTAL, commandType);
TestAndSetValue(value, MyEol, token, commandType);
end;
oQUOTE :
begin
ScanForValue(commandLine, commandLen, value,
CHRACTER, commandType);
TestAndSetValue(value, MyQuote, token,
commandType);
end;
oQUESTIONM :
if (commandType = oSETTYPE) then
PrintSetSendReceiveHelp
else
PrintShowSendReceiveHelp;
otherwise
if (commandType = oSETTYPE) then
PrintMessage(INVALIDSETCOMMAND)
else
PrintMessage(INVALIDSHOWCOMMAND);
end;
end;
oTRANSMODE :
begin
ScanForToken(commandLine, commandLen, value, oTRANSTYPE);
TestAndSetValue(value, transtype, token, commandType);
end;
oEIGHTQUOTE :
begin
ScanForValue(commandLine, commandLen, value,
EBCHRACTER, commandType);
TestAndSetValue(value, EBQChar, token, commandType);
end;
oDEBUGGING :
begin
ScanForToken(commandLine, commandLen, value, oDEBUGTYPE);
TestAndSetValue(value, debugging, token, commandType);
end;
oFILERECORD :
begin
ScanForToken(commandLine, commandLen, value, oFILERECTYPE);
TestAndSetValue(value, fileEOL, token, commandType);
end;
oLOCALECHO :
begin
ScanForToken(commandLine, commandLen, value, oLOCECHOTYPE);
TestAndSetValue(value, localEcho, token, commandType);
end;
oPARITY :
begin
ScanForToken(commandLine, commandLen, value, oPARITYTYPE);
TestAndSetValue(value, parity, token, commandType);
end;
oSPEED :
begin
ScanForValue(commandLine, commandLen, value,
IDECIMAL, commandType);
TestAndSetValue(value, lSpeed, token, commandType);
end;
oDELAY :
begin
ScanForValue(commandLine, commandLen, value,
DECIMAL, commandType);
TestAndSetValue(value, delay, token, commandType);
end;
oQUESTIONM :
if (commandType = oSETTYPE) then
PrintSetHelp
else
PrintShowHelp;
oALL :
if (commandType = oSHOWTYPE) then
PrintAllParameters
else
PrintMessage(INVALIDSETCOMMAND);
otherwise
if (commandType = oSETTYPE) then
PrintMessage(INVALIDSETCOMMAND)
else
{ Print all }
PrintAllParameters;
end;
end;
{ Routine to Parse the incoming line for a valid command. }
procedure ParseInput(var commandLine : string80;
var commandLen : integer;
var runType : command);
const
%include 'kermdir:pglobal.pas/nolist'
var
token : integer;
begin
ScanForToken(commandLine, commandLen, token, oMAINTYPE);
case token of
oSET : ParseSetShowCommand(commandLine, commandLen, oSETTYPE);
oSHOW : ParseSetShowCommand(commandLine, commandLen, oSHOWTYPE);
oSEND,
oRECEIVE :
begin
ParseSendReceiveCommand(commandLine, commandLen,
fileSpec, token);
if ((token = oSEND) and (sFileSpec = oON)) then
runType := Transmit
else if (token = oRECEIVE) then
runType := Receive;
end;
oSTATUS : PrintStatus;
oCONNECT : runType := Connect;
oDCL : ExecShell(commandLine, commandLen);
oHELP : PrintHelpVMS;
oQUESTIONM : PrintMainHelp;
oEXIT,
oQUIT : exitProgram := true;
otherwise
PrintMessage(INVALIDCOMMAND);
end;
end;
{ Routine to print command line prompt and get user input }
function CommandPrompt(var commandLine : string80;
var commandLen : integer) : boolean;
const
%include 'kermdir:pglobal.pas/nolist'
%include 'kermdir:version.pas'
var
noInput : boolean;
begin
noInput := true;
write(KERMITPROMPT);
while ((noInput) and (not eof)) do
begin
readln(commandLine);
commandLen := LenString(commandLine);
if (commandLen > 0) then
begin
noInput := false;
StrUpcase(commandLine, commandLen);
SkipBlanks(commandLine, commandLen);
end
else
write(KERMITPROMPT);
end;
CommandPrompt := not(noInput);
end;
procedure PromptAndParseUser(var exitProgram : boolean;
var RunType : command);
begin
while ( not(exitProgram) and
not((RunType = Receive) or
(RunType = Transmit) or
(RunType = Connect)) ) do
begin
if CommandPrompt(commandLine, commandLen) then
ParseInput(commandLine, commandLen, RunType)
else
exitProgram := true;
end;
{ Set parms that could not be set normally }
if (debugging = oOFF) then
debug := false
else
debug := true;
if (fileEol = oLF) then
EOLFORFILE := LineFeed
else if (fileEol = oCLF) then
EOLFORFILE := CrLf
else
EOLFORFILE := JustCr;
if (transtype = oASCII) then
begin
EBQstate := Ascii;
binascflg := oASCSTATE;
end
else
begin
EBQstate := Binary;
binascflg := oBINSTATE;
end;
vmsFilePnt := 0;
end;