home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
perqb.tar.gz
/
perqb.tar
/
pq2par.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-06-06
|
42KB
|
1,322 lines
module KermitParameters;
exports
imports KermitGlobals from KermitGlobals;
imports MenuUtils from MenuUtils;
imports FileDefs from FileDefs;
const MaxParts = 30;
{ NBNBNB!! These type definitions MUST ALWAYS correspond to the
sequence of the menu items in the Kermit.MENU file }
type
MainCommType = (NoMainComm,
MainHelp,
MainSend,
MainReceive,
MainGet,
MainExit,
MainQuit,
MainPush,
MainTake,
MainConnect,
MainBye,
MainFinish,
MainRemote,
MainLocal,
MainServer,
MainSet,
MainShow,
MainStatus,
MainUsage,
MainNotFound,
MainNotUnique,
MainEmptyLine,
MainSwitch,
MainIllegChar);
TermCommType = (NoTermComm,
TermHelp,
TermQuit,
TermSetBaud,
TermSetStop,
TermSetParity,
TermSaveFile,
TermOnSave,
TermOffSave,
TermOnXonXoff,
TermOffXonXoff);
SetCommType = (NoSetComm,
SetHelp,
SetBaud,
SetParity,
SetStop,
SetSend,
SetReceive,
SetFileHeader,
Set8BitQuote,
SetUse8BitQuote,
SetRepFix,
SetUseRepFix,
SetFileWarning,
SetRetry,
SetLogFile,
SetLog,
SetDebugging,
SetBreakTime,
SetEscape,
SetNotFound,
SetNotUnique,
SetEmptyLine,
SetSwitch,
SetIllegChar);
SendRecType = (NoSendRec,
SRHelp,
SRPacketLength,
SRCtlQuote,
SRStartOfPacket,
SRTimeOut,
SREndOfLine,
SRPadding,
SRPadChar);
FHeaderType = (NoFHeader,
FHHelp,
FHNord,
FHNoTrunc,
FHTrunc,
FHTrans);
TransType = (NoTrans,
TransHelp,
TransLower,
TransUpper,
TransOff);
RetryType = (NoRetryType,
RetryHelp,
RetryInitial,
RetryPacket,
RetryCommand);
OnOffType = (NoOnOff,
OnOffHelp,
On,
Off,
OnOfNotFound,
OnOfNotUnique,
OnOfEmptyLine,
OnOfSwitch,
OnOfIllegChar);
EmptyType = (NoEmpty,
EmptyHelp,
EmptyAndVoid,
EmpNotFound,
EmpNotUnique,
EmptyLine,
EmptySwitch,
EmptyIllegChar);
SpeedType = (NoSpeed,
SpHelp,
Sp110,
Sp150,
Sp300,
Sp600,
Sp1200,
Sp2400,
Sp4800,
Sp9600,
SpNotFound,
SpNotUnique,
SpEmptyLine,
SpSwitch,
SpIllegChar);
ParityType = (NoParComm,
ParHelp,
NoKParity,
EvenKParity,
OddKParity,
MarkKParity,
SpaceKParity,
ParNotFound,
ParNotUnique,
ParEmptyLine,
ParSwitch,
ParIllegChar);
StopType = (NoStopComm,
StopHelp,
SyncrCmd,
Stop1Cmd,
Stop1x5Cmd,
Stop2Cmd,
StopNotFound,
StopNotUnique,
StopEmptyLine,
StopSwitch,
StopIllegChar);
TruncPart = 1..MaxParts;
TListType = array [TruncPart] of integer;
const
NMainComm = ord(MainNotFound)-1;
NTermComm = ord(TermOffXonXoff);
NSetComm = ord(SetNotFound)-1;
NOnOff = ord(OnOfNotFound)-1;
NSpeeds = ord(SpNotFound)-1;
NParityComm = ord(ParNotFound)-1;
NStopComm = ord(StopNotFound)-1;
NEmptyComm = ord(EmpNotFound)-1;
var
RootMenu : pMenuEntry; { Pointer to root of menu structure }
Parity : ParityType; { Current parity setting }
Baud : SpeedType; { Current baud rate setting }
StopBits : StopType; { Current number of stop bits }
SendSOH : char; { Start-Of-Packet to send }
SendPSize : integer; { Packet size he wants }
SendTimeOut : integer; { Time-out he wants }
SendNPad : integer; { Number of padding-characters he wants }
SendPadChar : char; { The padding character he wants }
SendEOL : char; { The EOL he wants }
SendQuote : char; { The Quote char he wants }
RecSOH : char; { Start-Of-Packet I want }
RecPSize : integer; { Max packet size I can handle }
RecTimeOut : integer; { time-out I want }
RecNPad : integer; { Padding I want }
RecPadChar : char; { Padchar I want }
RecEOL : char; { End-Of-Line I propose }
RecQuote : char; { Control quote I propose }
Use8Quote : boolean; { Is 8-bit quoting in use? }
Bit8Quote : char; { 8-bit Quote character to be used }
UseRepFix : boolean; { Is repeat prefixing in use? }
RepFix : char; { Repeat prefix to be used }
NowUse8Quote,
NowUseRepFix : boolean; { - enabled during this transfer?? }
Debug : boolean; { Enable debug output }
FileWarning : boolean; { Avoid overwriting existing file if TRUE}
XonXoff : boolean; { use XonXoff handshaking }
FileSave : boolean; { Log terminal session to file }
SaveFile : PathName;
Nord : boolean; { Translate file names for NORD }
NumTrunc,
OldTrunc : integer; { Truncation list }
TruncList : TListType;
Translate : TransType; { Case translation }
MaxTryPack : Integer; { Retry limits before giving up }
MaxTryInit : Integer;
MaxTryComm : Integer;
LongWait : Integer;
LocalKermit : boolean; { Is this Kermit a local one? }
DisableTimOut : boolean; { TRUE if timeout is disabled }
Idev,Odev : integer; { Which devices to use for line }
LegalPackets, { valid packet types }
CtlMapping, { Control character mapping }
OkQuote, { Valid quote characters }
Quotes : set of char; { Quotes presently in use }
EscKey : char; { Char to type to escape CONNECT }
procedure SetInitPars( var Pack : Packet );
procedure ReadPars ( VAR Pack : Packet );
procedure InitParameters;
procedure CleanupParameters;
procedure SetCommand( PList : pPListEntry );
procedure ShowCommand( PList : pPListEntry );
procedure StatusCommand;
procedure ShowKey( Ch : char );
{================} private {=================}
imports KermitLineIO from KermitLineIO;
imports KermitConnect from KermitConnect;
imports IOErrors from IOErrors;
imports IO_Unit from IO_Unit;
imports IO_Others from IO_Others;
exception NotInt;
procedure EatSpaces( var S : String );
begin
if S<>'' then
while (S[1]=' ') and (length(S)>1) do
Delete( S, 1, 1);
if S=' ' then
S := '';
end;
function StrToInt( VAR S : String ):integer;
var I :integer;
done : boolean;
begin
I := 0;
done := false;
EatSpaces( S );
if S='' then
raise NotInt
else begin
if not (S[1] in ['0'..'9']) then
raise NotInt
else
repeat
if not (S[1] in ['0'..'9']) then
done := true
else begin
I := I*10 + ord(S[1]) - ord('0');
Delete( S, 1, 1);
Done := S='';
end;
until done;
end;
StrToInt := I;
end;
function CtrlChar( S:String ):integer;
handler NotInt;
begin
CtrlChar := -1;
exit( CtrlChar );
end;
var R : integer;
begin
if length( S )=0 then
R := -1
else
if length( S )=1 then
R := ord( S[1] )
else
if S[1]='#' then begin
Delete( S, 1, 1);
R := StrToInt( S );
end else
if S[1]='^' then
if S[2] in ['@'..'^'] then
R := ord( Ctl(S[2]) )
else
R := -1;
CtrlChar := R;
end;
procedure DoSetRetry( PList : pPListEntry );
var Val : integer;
handler NotInt;
begin
writeln('Number of retries not numeric!');
exit( DoSetRetry );
end;
begin
Val := StrToInt( PList^.NextPList^.Arg );
if not (Val in [1..30]) then
writeln('Illegal number of retries!')
else
case recast( PList^.Selection, RetryType ) of
RetryInitial: MaxTryInit := Val;
RetryPacket: MaxTryPack := Val;
RetryCommand: MaxTryComm := Val;
otherwise: ;
end;
end;
procedure SetPSize( Arg : String; var PSize : integer );
var Val : integer;
handler NotInt;
begin
writeln('Packet length not numeric!');
exit( SetPSize );
end;
begin
Val := StrToInt( Arg );
if not (Val in [10..94]) then
writeln( 'Illegal packet length!')
else
PSize := Val;
end;
procedure SetQuote( Arg : String; var Quote : char );
var Val : integer;
begin
Val := CtrlChar( Arg );
if Val=-1 then
writeln( 'Control quote ordinal value is not numeric!' )
else
if not ( chr(Val) in OkQuote ) then
writeln( 'Illegal quote character')
else
if chr(Val) in Quotes then
writeln( 'Character is already in use as another quote' )
else
Quote := chr( Val );
end;
procedure SetSOH( Arg : String; var SOH : char );
var Val : integer;
begin
Val := CtrlChar( Arg );
if Val=-1 then
writeln( 'Start-of-packet ordinal value is not numeric!' )
else
if not ( Val in [0..31,127,128..159,255]) then
writeln
('Start-of-packet character must be a control character!')
else
SOH := chr( Val );
end;
procedure SetTimeOut( Arg : String; var TimeOut : integer );
var Val : integer;
handler NotInt;
begin
writeln('Timeout interval not numeric!');
exit( SetTimeOut );
end;
begin
if Arg='' then
TimeOut := 0
else begin
Val := StrToInt( Arg );
if not (Val in [0..94]) then
writeln( 'Illegal timeout interval!')
else
TimeOut := Val;
end;
end;
procedure SetEOL( Arg : String; var EOL : char );
var Val : integer;
begin
Val := CtrlChar( Arg );
if Val=-1 then
writeln( 'End-of-line ordinal value is not numeric!' )
else
EOL := chr( Val );
end;
procedure SetNPad( Arg : String; var NPad : integer );
var Val : integer;
handler NotInt;
begin
writeln('Padding value not numeric!');
exit( SetNPad );
end;
begin
Val := StrToInt( Arg );
if not (Val in [0..94]) then
writeln( 'Illegal padding value!')
else
NPad := Val;
end;
procedure SetPadChar( Arg : String; var PadChar : char );
var Val : integer;
begin
Val := CtrlChar( Arg );
if Val=-1 then
writeln( 'Pad character ordinal value is not numeric!' )
else
PadChar := chr( Val );
end;
procedure ShowKey( Ch : char );
begin
if Land( ord( Ch ), #200 ) <>0 then begin
write( 'CTRL-' );
ch := chr( land( ord( ch ), #177 ) );
end;
if Ch='' then write('OOPS') else
if Ch='' then write('INS') else
if Ch=' ' then write('TAB') else
if Ch='' then write('HELP') else
if Ch='' then write('DEL') else
if Ch='' then write('BACKSPACE') else begin
if Ch in ['A'..'Z'] then
write( 'SHIFT-' );
write( Ch );
end;
end;
procedure SetEscChar( Arg : String );
var Val : integer;
begin
if Arg='' then begin
IOKeyClear;
write( 'Press the key which you want as escape character:' );
while IOCRead( KeyBoard, EscKey ) <> IOEIOC do ;
writeln;
write( 'Escape character set as: ');
ShowKey( EscKey );
writeln;
end else begin
Val := CtrlChar( Arg );
if Val=-1 then
writeln( 'Escape character ordinal value is not numeric!')
else
EscKey := chr( Val );
end;
end;
procedure DoSetSend( PList : pPListEntry );
var TempQuote : set of char;
begin
with PList^ do
case recast( Selection, SendRecType ) of
SRPacketLength: SetPSize( NextPList^.Arg, SendPSize );
SRCtlQuote:
begin
TempQuote := Quotes;
Quotes := []; { SendQuote may be same as 8-bi or repeat }
SetQuote( NextPList^.Arg, SendQuote );
Quotes := TempQuote;
end;
SRStartOfPacket:SetSOH( NextPList^.Arg, SendSOH );
SRTimeOut: SetTimeOut( NextPList^.Arg, SendTimeOut );
SREndOfLine: SetEOL( NextPList^.Arg, SendEOL );
SRPadding: SetNPad( NextPList^.Arg, SendNPad );
SRPadChar: SetPadChar( NextPList^.Arg, SendPadChar );
otherwise: ;
end;
end;
procedure DoSetReceive( PList : pPListEntry );
begin
with PList^ do
case recast( Selection, SendRecType ) of
SRPacketLength: SetPSize( NextPList^.Arg, RecPSize );
SRCtlQuote:
begin
Quotes := Quotes - [RecQuote];
SetQuote( NextPList^.Arg, RecQuote );
Quotes := Quotes + [RecQuote];
end;
SRStartOfPacket:SetSOH( NextPList^.Arg, RecSOH );
SRTimeOut: SetTimeOut( NextPList^.Arg, RecTimeOut );
otherwise: ;
end;
end;
procedure DoTruncation( PList : pPListEntry );
var NewTrunc : integer;
NewTList : TListType;
handler NotInt;
begin
writeln('Truncation value must be an integer!');
exit( DoTruncation );
end;
begin
with PList^ do
if Arg='' then
NumTrunc := OldTrunc
else begin
NewTrunc := 0;
EatSpaces( Arg );
while Arg<>'' do begin
NewTrunc := NewTrunc + 1;
NewTList[NewTrunc] := StrToInt( Arg );
EatSpaces( Arg );
if Arg<>'' then
if Arg[1]=',' then
Delete( Arg, 1, 1 );
EatSpaces( Arg );
end;
NumTrunc := NewTrunc;
OldTrunc := NewTrunc;
TruncList := NewTList;
end;
end;
procedure DoSetFHeader( PList : pPListEntry );
Const NordWarning = 'Warning: NORD transformation is ON!';
AsLongAs =
'is temporarily active for as long as NORD is ON in any case!';
begin
with PList^ do
case recast( Selection, FHeaderType ) of
FHNord:
Nord := recast( NextPList^.Selection, OnOffType) =On;
FHNoTrunc:
begin
OldTrunc := NumTrunc;
NumTrunc := 0;
if Nord then begin
writeln( NordWarning );
writeln(' NO-TRUNCATE ', AsLongAs );
writeln;
end;
end;
FHTrunc:
begin
DoTruncation( NextPList );
if Nord then begin
writeln( NordWarning );
write (' TRUNCATE will not take effect until');
writeln(' NORD is turned OFF!');
writeln;
end;
end;
FHTrans:
begin
Translate := recast( NextPList^.Selection, TransType );
if Nord then begin
writeln( NordWarning );
writeln( ' CONVERT UPPER ', AsLongAs );
writeln;
end;
end;
otherwise: ;
end;
end;
procedure DoSet8Quote( PList : pPListEntry );
var ch : char;
begin
Quotes := Quotes - [Bit8Quote];
if PList^.Arg='' then
Bit8Quote := '&'
else begin
ch := PList^.Arg[1];
if ch in OkQuote then begin
if ch in Quotes then
writeln
('Character is already in use as another quote' )
else
Bit8Quote := ch;
end
else
writeln('Illegal quote character!');
end;
Quotes := Quotes + [Bit8Quote];
end;
procedure DoSetRepFix( PList : pPListEntry );
var ch : char;
begin
Quotes := Quotes - [RepFix];
if PList^.Arg='' then
RepFix := '&'
else begin
ch := PList^.Arg[1];
if ch in OkQuote then begin
if ch in Quotes then
writeln
('Character is already in use as another quote' )
else
RepFix := ch;
end
else
writeln('Illegal quote character!');
end;
Quotes := Quotes + [RepFix];
end;
procedure SetCommand( PList : pPListEntry );
var SetParm : SetCommType;
begin
SetParm := recast( PList^.Selection, SetCommType );
PList := PList^.NextPList;
case SetParm of
SetStop:
begin
StopBits := recast( PList^.Selection, StopType );
RefreshStopBits;
end;
SetParity:
begin
Parity := recast( PList^.Selection, ParityType );
RefreshParity;
end;
SetBaud:
begin
Baud := recast( PList^.Selection, SpeedType);
RefreshBaud;
end;
SetFileWarning:
begin
FileWarning :=
recast( PList^.Selection, OnOffType ) = On;
end;
SetLog:
begin
FileSave :=
recast( PList^.Selection, OnOffType ) = On;
end;
SetLogFile:
begin
SetSaveFile( PList^.Arg );
end;
SetDebugging:
begin
Debug :=
recast( PList^.Selection, OnOffType ) = On;
end;
SetSend:
DoSetSend( PList );
SetReceive:
DoSetReceive( PList );
SetFileHeader:
DoSetFHeader( PList );
Set8BitQuote:
DoSet8Quote( PList );
SetUse8BitQuote:
Use8Quote := recast( PList^.Selection, OnOffType ) = On;
SetRepFix:
DoSetRepFix( PList );
SetUseRepFix:
UseRepFix := recast( PList^.Selection, OnOffType ) = On;
SetRetry:
DoSetRetry( PList );
SetBreakTime:
writeln('Send break is not implemented!');
SetEscape:
SetEscChar( PList^.Arg );
otherwise:
writeln('Bad SET alternative: ', ord( SetParm ) );
end;
end;
procedure ShowOnOff( OnValue : boolean );
begin
if OnValue then
write('ON')
else
write('OFF');
end;
procedure ShowStop;
begin
if StopBits=SyncrCmd then
writeln( 'SYNCHRONOUS mode, no stop bits' )
else begin
write('Number of STOP-BITS = ');
case StopBits of
Stop1Cmd: writeln('1');
Stop1x5Cmd: writeln('1.5');
Stop2Cmd: writeln('2');
otherwise: writeln('invalid, code: ',ord(StopBits));
end;
end;
end;
procedure ShowParity;
begin
write( 'PARITY check/generation = ' );
case Parity of
NoKParity: writeln('NONE');
EvenKParity: writeln('EVEN');
OddKParity: writeln('ODD');
MarkKParity: writeln('MARK (1)');
SpaceKParity: writeln('SPACE (0)');
otherwise: writeln('invalid, code: ',ord(Parity));
end;
end;
procedure ShowBaud;
begin
write( 'BAUDrate = ' );
case Baud of
SP110: write('110');
SP150: write('150');
SP300: write('300');
SP600: write('600');
SP1200: write('1200');
SP2400: write('2400');
SP4800: write('4800');
SP9600: write('9600');
otherwise: writeln('invalid, code: ',ord(Baud));
end;
if Baud in [SP110..SP9600] then
writeln(' bps');
end;
procedure ShowFWarning;
begin
write( 'FILE-WARNING = ');
ShowOnOff( FileWarning );
writeln;
end;
procedure ShowDebug;
begin
write( 'DEBUG output = ');
ShowOnOff( Debug );
writeln;
end;
procedure ShowUse8Quote;
begin
write( 'USE-8-BIT-QUOTE = ');
if Use8Quote then
write('AUTO')
else
write('OFF');
writeln;
end;
procedure ShowUseRepFix;
begin
write( 'USE-REPEAT-PREFIX = ');
if UseRepFix then
write('AUTO')
else
write('OFF');
writeln;
end;
procedure ShowLog;
begin
write( 'LOG session to file = ' );
ShowOnOff( FileSave );
writeln;
end;
procedure ShowLFile;
begin
if SaveFile='' then
writeln('No log file active')
else
writeln('LOG-FILE = ',SaveFile);
end;
procedure DisplayChar( Ch : Char );
var Ch1 : char;
begin
Ch1 := Chr( LAnd( Ord( Ch ), #177 ) );
if ch1<' ' then
write( 'Ctrl-', Ctl( Ch1 ) )
else
if ord(Ch1)=177 then
write( 'DEL' )
else
write('''',Ch1,'''');
if Ch<>Ch1 then write(' (Hi bit=1)');
end;
procedure Show8Quote;
begin
write('8-BIT-QUOTE = ');
DisplayChar( Bit8Quote );
writeln;
end;
procedure ShowRepFix;
begin
write('REPEAT-PREFIX = ');
DisplayChar( RepFix );
writeln;
end;
procedure ShowEscChar;
begin
write('ESCAPE-CHARACTER = ');
ShowKey( EscKey );
writeln;
end;
procedure ShowPSize( PSize : integer );
begin
writeln(' max. PACKET-LENGTH = ', PSize:2 );
end;
procedure ShowTOut( TimeOut : integer );
begin
writeln(' TIME-OUT after ',TimeOut:2,' seconds');
end;
procedure ShowQuote( Quote : char );
begin
writeln(' control QUOTE = ''',Quote,'''');
end;
procedure ShowSOH( SOH : char );
begin
write(' START-OF-PACKET = ');
DisplayChar( SOH );
writeln;
end;
procedure ShowEOL( EOL : char );
begin
write(' END-OF-LINE = ');
DisplayChar( EOL );
writeln;
end;
procedure ShowPad( Padding : integer );
begin
writeln(' PADDING between packets = ', Padding:2,' characters');
end;
procedure ShowPChar( PadChar : char );
begin
write(' PADCHAR = ');
DisplayChar( PadChar );
writeln;
end;
procedure ShowSend;
begin
writeln( 'SEND parameters:');
ShowPSize( SendPSize );
ShowTOut( SendTimeOut );
ShowQuote( SendQuote );
ShowSOH( SendSOH );
ShowEOL( SendEOL );
ShowPad( SendNPad );
ShowPChar( SendPadChar );
end;
procedure ShowReceive;
begin
writeln( 'RECEIVE parameters:');
ShowPSize( RecPSize );
ShowTOut( RecTimeOut );
ShowQuote( RecQuote );
ShowSOH( RecSOH );
end;
procedure ShowFHeader;
var I : integer;
begin
writeln( 'FILE-HEADER transformations: ');
write( ' NORD transformation = ');
if Nord then begin
writeln( ' ON');
writeln( ' (temporary NO-TRUNCATE and CONVERT UPPER)');
end else begin
writeln( ' OFF');
if NumTrunc=0 then
writeln(' NO-TRUNCATE of file name')
else begin
write(' TRUNCATE file name ');
write( TruncList[1]:1 );
for i := 2 to NumTrunc do
write( ',', TruncList[I]:1 );
writeln;
end;
if Translate=TransOff then
writeln(' CONVERT OFF')
else begin
write(' CONVERT file name into ');
case Translate of
TransUpper:
writeln('UPPER case');
TransLower:
writeln('LOWER case');
otherwise:
writeln('<illegal parameter value>');
end;
end;
end;
end;
procedure ShowRetry;
begin
writeln( 'RETRY limits:');
writeln( ' INITIAL-CONNECTION = ',MaxTryInit:2);
writeln( ' PACKET = ',MaxTryPack:2);
writeln( ' COMMANDS = ',MaxTryComm:2);
end;
procedure ShowCommand( PList : pPListEntry );
var SetParm : SetCommType;
begin
SetParm := recast( PList^.Selection, SetCommType );
PList := PList^.NextPList;
writeln;
case SetParm of
SetStop:
ShowStop;
SetParity:
ShowParity;
SetBaud:
ShowBaud;
SetFileWarning:
ShowFWarning;
SetLog:
ShowLog;
SetLogFile:
ShowLFile;
SetDebugging:
ShowDebug;
SetSend:
ShowSend;
SetReceive:
ShowReceive;
SetFileHeader:
ShowFHeader;
Set8BitQuote:
Show8Quote;
SetUse8BitQuote:
ShowUse8Quote;
SetRepFix:
ShowRepFix;
SetUseRepFix:
ShowUseRepFix;
SetRetry:
ShowRetry;
SetBreakTime:
writeln('Send break is not implemented!');
SetEscape:
ShowEscChar;
SetNotFound:
begin
ShowStop;
ShowParity;
ShowBaud;
ShowFWarning;
ShowLog;
ShowLFile;
ShowDebug;
ShowSend;
ShowReceive;
ShowFHeader;
Show8Quote;
ShowUse8Quote;
ShowRepFix;
ShowUseRepFix;
ShowRetry;
ShowEscChar;
end;
otherwise:
writeln('Bad SHOW alternative: ', ord( SetParm ) );
end;
writeln;
end;
procedure StatusCommand;
begin
end;
procedure SetInitPars( var Pack : Packet );
{ Build SendInit packet }
var PackLen : integer;
begin
with Pack do
begin
adjust( Data, 100 );
data[1] := ToChar(chr(RecPSize )); { Max. packet length I handle }
data[2] := ToChar(chr(RecTimeOut)); { When I want to be timed out }
data[3] := ToChar(chr(RecNPad )); { How much padding I need }
data[4] := ctl (chr(RecPadChar)); { My padding character }
data[5] := ToChar(chr(RecEOL) ); { End-of-line I want }
data[6] := RecQuote ; { control-quote char I want }
data[8] := '1'; { Only 1-char checksum }
if (not Use8Quote) or (Parity=NoKParity) then
data[7] := 'N' { No need to use 8-bit quote }
else
data[7] := Bit8Quote ; { 8-bit-quote char I want }
if not UseRepFix then
data[9] := ' ' { Won't use repeat prefix }
else
data[9] := RepFix; { Repeat prefix I want }
PackLen := 9;
if Data[9]=' ' then begin
PackLen := 8;
if Data[8]='1' then begin
PackLen := 7;
if Data[7] in [' ','N'] then begin
PackLen := 6;
end;
end;
end;
Count := ToChar ( chr( PackLen + 3 ) );
adjust( Data, PackLen + 1 );
ptype:= PackToCh( SInitPack );
end;
end;
procedure ReadPars ( VAR Pack : Packet );
{ Set parameters according to Pack (Which is SendInit or
Acknowledge packet)
and build the corresponding Acknowledge packet }
VAR i,PackLen : integer;
begin
with Pack do
if not ( ChToPack(Ptype) IN [SInitPack,ACKPack] ) then
begin
CurrState := AbortAll;
LocalError
( '?Attempted to read parameters from non-send-init packet' );
end
else
begin
adjust( Data, 100 );
PackLen := ord( UnChar( count ) ) - 3;
for i := PackLen + 1 to MaxString do
Data[i] := ' ';
{ Don't have to agree on the following parameters }
if UnChar( Data[1] ) = chr(0) then
SendPSize := 96
else
SendPSize := ord ( UnChar ( Data[1] ) );
data[1] := ToChar( chr( RecPSize ) );
SendTimeOut := ord ( UnChar ( Data[2] ) );
data[2] := ToChar( chr(RecTimeOut) );
{ SendNPad := ord ( UnChar ( Data[3] ) ); }
data[3] := ToChar( chr(RecNPad) );
if UnChar(Data[4])=chr(0) then
SendPadChar := chr(0)
else
SendPadChar := Ctl ( Data[4] ) ;
data[4] := ctl( RecPadChar );
if UnChar(Data[5])=chr(0) then
SendEOL := chr(13)
else
SendEOL := UnChar ( Data[5] ) ;
data[5] := ToChar( RecEOL );
if UnChar(Data[5])=chr(0) then
SendQuote := '#'
else
SendQuote := Data[6] ;
data[6] := RecQuote;
{ On this one, we have to agree, else there will be no 8-bit quoting }
if not ( (Data[7] in (OkQuote + ['Y'])) and Use8Quote ) then
begin
{ Default, if not acceptable 8-bit quote character }
NowUse8Quote := FALSE;
Data[7] := 'N'; { I agree NOT to do 8-bit quoting }
end
else
begin
NowUse8Quote := TRUE; { Only if this Kermit is sending: }
if Data[7]<>'Y' then { 'Y' means my request to use }
Bit8Quote := Data[7]; { 8-bit quoting is accepted }
{ Else: use proposed quote char }
Data[7] := 'Y'; { I agree to do 8-bit quoting }
end;
{ Checksum type : Default is 1-character checksum }
Data[8] := '1'; { Not supporting 2 or 3-character checksums yet }
{ Repeat prefix : have to agree, else no repeat prefixing }
if not ( (Data[9] in OkQuote) and UseRepFix ) then
begin
{ Default, if not acceptable repeat prefix }
NowUseRepFix := FALSE;
Data[9] := ' '; { I won't do repeat prefixing }
end
else
begin
NowUseRepFix := TRUE; { repeat prefix is accepted }
RepFix := Data[9]; { agree by returning same value }
end;
if (Bit8Quote=SendQuote) and NowUse8Quote then begin
LocalError('?Cant send same 8-bit quote and control quote');
LocalError(' Denies 8-bit quoting!' );
Data[7] := ' ';
NowUse8Quote := false;
end;
if (RepFix=SendQuote) and NowUseRepFix then begin
LocalError('?Cant send same repeat prefix and control quote');
LocalError(' Denies repeat prefixing!');
Data[9] := ' ';
NowUseRepFix := false;
end;
if (RepFix=Bit8Quote) and NowUseRepFix and NowUse8Quote then
begin
LocalError('?Cant send same repeat prefix and 8-bit quote');
LocalError(' Denies repeat prefixing!');
Data[9] := ' ';
NowUseRepFix := false;
end;
PackLen := 9;
if Data[9]=' ' then begin
PackLen := 8;
if Data[8]='1' then begin
PackLen := 7;
if Data[7] in [' ','N'] then begin
PackLen := 6;
end;
end;
end;
Count := ToChar ( chr( PackLen + 3 ) );
adjust( Data, PackLen + 1 );
Ptype := PackToCh ( ACKPack );
end;
end;
procedure InitParameters;
{ Abstract:
This procedure initializes various global Kermit variables:
"Constants", Transmission parameters, Kermit state variables.
NB! This procedure is to be called only ONCE during the run! }
begin
SaveFile := '';
LegalPackets := ['D','Y','N','S','B','F','Z','E','R','C','G','X'];
{ What I expect he will want }
SendSOH := chr(1);
SendPSize := 94; { - max. packet size }
SendTimeOut := 5; { - 5 seconds timeout }
SendNPad := 0; { - no padding }
SendPadChar := chr(0); { - ASCII NUL as padchar }
SendEOL := chr(13); { - carriage return as eol }
SendQuote := '#'; { - sharp as control quote }
{ What I want from him (parameters which will be used when I send-initiate) }
RecSOH := chr(1);
RecPSize := 59; { for a Perq with standard buffersize }
RecTimeOut := 5; { time-out I want }
RecNPad := 0; { Need no padding }
RecPadChar := chr(0);
RecEOL := chr(13); { Standard End-Of-Line }
RecQuote := '#'; { Standard control quote }
{ What to do about 8-bit quoting }
Use8Quote := FALSE; { 8-bit quoting disabled }
NowUse8Quote := Use8Quote;
Bit8Quote := '&';
UseRepFix := FALSE; { Repeat prefixing disable }
NowUseRepFix := UseRepFix;
RepFix := '~';
LongWait := 4; { Multiplication factor for TimeOut }
{ during SendFileHeader (to allow for opening file) }
LocalKermit := FALSE; { This frog is born a remote kermit }
DisableTimOut := FALSE; { Allow partner to enable timeout }
FileWarning := TRUE; { Do not write over existing files }
FileSave := FALSE;
Debug := FALSE;
Nord := FALSE; { Not NORD transformation }
TruncList[1] := 8;
TruncList[2] := 3;
NumTrunc := 2; { Truncate file name 8+3 }
OldTrunc := NumTrunc;
Translate := TransUpper; { Translate file names to upper case }
CurrState := Complete; { Avoid starting out in a bad state }
N := 0; { Start out with packet zero }
NumTry := 0;
OldTry := 0;
MaxTryInit := 8; { Retries before giving up }
MaxTryPack := 5;
MaxTryComm := 3;
EscKey := chr( ord(']')+128 ); { Control - ] }
{ Then some useful character sets : NB! they are recomputed by ReadPars }
{ This is the set which the set of control characters is mapped
into by the Ctl function }
CtlMapping := [ ctl( chr( 0) )..ctl( chr( 31) ), ctl( chr(127) ),
ctl( chr(128) )..ctl( chr(31+128) ), ctl( chr(255) )];
{ Valid quote characters, i.e all printable characters
which Ctl does not map a control character into }
OkQuote := ['!'..'~'] - CtlMapping;
Quotes := [RecQuote, Bit8Quote, RepFix];
end;
{=============================================================================}
procedure CleanupParameters;
begin
SetSaveFile( '' ); { force close of previous SaveFile }
end.