Category : Pascal Source Code
Archive   : QK3KER.ZIP
Filename : QK3GLB.PAS

Unit KGlobals ;
Interface
Const
Version = '3.0 ' ;
Date = '1988 April 28 ' ;
Buffersize = 10240 ;

SOH = $01 ; (* Start of Header *)
EOT = $04 ; (* End of transmission *)
BEL = $07 ;
BS = $08 ; (* Back Space *)
FF = $0C ;
CR = $0D ;
Xon = $11 ;
Xoff = $13 ;
SUB = $1A ;
ESC = $1B ;
FS = $1C ;
GS = $1D ;
RS = $1E ;
US = $1F ;
DEL = $7F ;

Var
(* Operational Options Toggles *)
LocalEcho,
NoEcho,
XonXoff,
AudioFlag,
AplFlag,
ParmFlag,
Line25Flag : Boolean ;

(* Execution Control flags *)
Running,
Connected,
WaitXon,
Logging,
ForPrinter,
TakeActive,
GotSOH : Boolean ;

LogName : String ;
Logfile : Text ;
CommandFile : Text ;

(* Global Functions *)
Function GETTOKEN ( var instring : String) : String ;
Function UpperCase ( instring : String) : String ;
Function Prefixof ( afilename : String) : String;
Function NewAsFile (MyFiles,Filename,AsFiles : String;
var AsFile : String ): boolean;

Implementation
(* ----------------------------------------------------------------- *)
(* GETTOKEN - Function *)
(* ----------------------------------------------------------------- *)
Function GETTOKEN ( var instring : String) : String ;
Var
pt : byte ;
Begin (* GETTOKEN *)
While (instring[1] = ' ') and (length(instring)>1) do
Delete(instring,1,1); (* eliminate leading blanks *)
pt := POS(' ',instring);
if pt = 0 then pt := length(instring)+1 ;
GETTOKEN := copy(instring,1,pt-1);
DELETE(instring,1,pt);
End ; (* GETTOKEN *)

(* ----------------------------------------------------------------- *)
(* UpperCase - Function *)
(* ----------------------------------------------------------------- *)
Function UpperCase ( instring : String) : String ;
Var
ix,len : integer ;

Begin (* UpperCase *)
len := length(instring) ;
for ix := 1 to len do instring[ix] := Upcase(instring[ix]);
UpperCase := instring ;
End ; (* UpperCase *)

(* ----------------------------------------------------------------- *)
(* Prefixof Function - Returns a char string of the dir prefix. *)
(* ----------------------------------------------------------------- *)
function Prefixof(afilename:String) : String;
var i :integer;
label exit ;
begin (* Prefixof *)
while length(afilename)>0 do
If afilename[length(afilename)] in [':','\','/']
then goto exit
else delete(afilename,length(afilename),1);
exit:
Prefixof := afilename ;
end; (* Prefixof *)

(* ----------------------------------------------------------------- *)
(* NewAsFile - returns a new ASFILE name in the parameter AsFile. *)
(* MyFiles - is the wild char name. *)
(* Filename - is the filename to be renamed . *)
(* AsFiles - is the wild char name of new file. *)
(* AsFile - is the new file name. *)
(* returns TRUE if AsFile correctly assigned. *)
(* returns FALSE if AsFile detected an error in assignment *)
(* There is a BUG in the MsDoS Call to get next Directory Entry *)
(* therefore this function may return FALSE. *)
(* *)
(* ----------------------------------------------------------------- *)
Function NewAsFile (MyFiles,Filename,AsFiles: String;
var AsFile : String ): boolean;
var
temp : String ;
si,ix,iy : integer ;
star : packed array[1..8] of string[20];
Label Subdir,Exit;

Begin (* NewAsFile Function *)
for si := 1 to 8 do star[si] := '*';
si := 0 ;
MyFiles := Uppercase(Myfiles);
FileName := Uppercase(Filename);
AsFiles := Uppercase(AsFiles);
ix := Pos(':',MyFiles) ;
If ix > 1 then delete(MyFiles,1,ix) ; (* Eliminate filemode prefix *)
subdir:
ix := Pos('\',MyFiles) ;
If ix > 1 then delete(MyFiles,1,ix) ; (* Eliminate sub-dir prefixs *)
if ix > 1 then goto subdir ;
ix := Pos(':',AsFiles) ;
If ix > 1 then delete(AsFiles,1,ix) ; (* Eliminate filemode prefix *)
While (length(Filename) > 0) and (length(Myfiles)>0) Do
Begin (* Scan filename *)
If MyFiles[1] = Filename[1] then
Begin delete(MyFiles,1,1) ; delete(Filename,1,1); end
else
Begin (* get star string *)
si:=si+1 ;
delete(MyFiles,1,1);
ix := Pos('*',MyFiles) - 1 ; (* Next wild char *)
if ix <= 0 then temp := MyFiles
else temp := copy(Myfiles,1,ix);
iy := Pos(temp,Filename)-1 ;
if iy < 0 then
begin NEWASFILE:=FALSE; Asfile:='temp.dat'; Goto exit ; end;
if iy = 0 then star[si] := filename
else star[si] := copy(filename,1,iy);
delete(FileName,1,iy);
End ;(* get star string *)
End; (* Scan filename *)
ix := 1 ;
si := 1 ;
AsFile := '';
While ix <= length(AsFiles) do
Begin (* Create AsFile name *)
If AsFiles[ix] in ['*','?'] then
Begin (* wild char *)
AsFile := Concat(AsFile,star[si]);
si := si + 1 ;
End
else
AsFile := Concat(AsFile,Asfiles[ix]);
ix := ix + 1 ;
End ; (* Create AsFile name *)
NewAsFile := True ;
Exit:
End; (* NewASFile Function *)

Begin ;
(* Default Settings *)
XonXoff := False ;
NoEcho := True ;
LocalEcho := False ;
AudioFlag := False ;
AplFlag := False ;
ParmFlag := False ;
Line25Flag := True ;

(* Execution control flags *)
Running := true ;
connected := false ;
logging := false ;
ForPrinter := false ;
TakeActive := false ;
GotSOH := false ;
WaitXon := false ;
End. (* KGlobals *)