home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3glb.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  6KB  |  192 lines
  1. Unit KGlobals ;
  2. Interface
  3.   Const
  4.     Version = '3.1 ' ;
  5.     Date    = '1988 October 7   ' ;
  6.     Buffersize = 10240 ;
  7.  
  8.     SOH  = $01 ;        (* Start of Header *)
  9.     EOT  = $04 ;        (* End of transmission *)
  10.     BEL  = $07 ;
  11.     BS   = $08 ;        (* Back Space *)
  12.     FF   = $0C ;
  13.     CR   = $0D ;
  14.     XON  = $11 ;
  15.     XOFF = $13 ;
  16.     SUB  = $1A ;
  17.     ESC  = $1B ;
  18.     FS   = $1C ;
  19.     GS   = $1D ;
  20.     RS   = $1E ;
  21.     US   = $1F ;
  22.     DEL  = $7F ;
  23.  
  24.   Var
  25.     (* Operational Options Toggles *)
  26.     LocalEcho,
  27.     NoEcho,
  28.     XonXoff,
  29.     AudioFlag,
  30.     AplFlag,
  31.     ParmFlag,
  32.     Line25Flag  : Boolean ;
  33.  
  34.     (* Execution Control flags *)
  35.     Running,
  36.     Connected,
  37.     WaitXon,
  38.     Logging,
  39.     ForPrinter,
  40.     TakeActive,
  41.     GotSOH      : Boolean ;
  42.  
  43.     LogName : String ;
  44.     Logfile : Text ;
  45.     CommandFile : Text ;
  46.  
  47.     (* Global Functions *)
  48.     Function GETTOKEN  ( var instring : String) : String ;
  49.     Function UpperCase (     instring : String) : String ;
  50.     Function Prefixof  (    afilename : String) : String ;
  51.     Function NewAsFile (MyFiles,Filename,AsFiles : String ;
  52.                                       var AsFile : String ): boolean;
  53.  
  54. Implementation
  55. (* ----------------------------------------------------------------- *)
  56. (* GETTOKEN - Function                                               *)
  57. (* ----------------------------------------------------------------- *)
  58. Function  GETTOKEN (var instring : String) : String ;
  59. Var
  60.     pt : byte ;
  61.     Begin (* GETTOKEN *)
  62.     While (instring[1] = ' ') and (length(instring)>1) do
  63.           Delete(instring,1,1);    (* eliminate leading blanks *)
  64.     pt := POS(' ',instring);
  65.     if pt = 0 then pt := length(instring)+1 ;
  66.     GETTOKEN := copy(instring,1,pt-1);
  67.     DELETE(instring,1,pt);
  68.     End ; (* GETTOKEN *)
  69.  
  70. (* ----------------------------------------------------------------- *)
  71. (* UpperCase - Function                                              *)
  72. (* ----------------------------------------------------------------- *)
  73. Function UpperCase ( instring : String) : String ;
  74. Var
  75.     ix,len : integer ;
  76.  
  77.     Begin (* UpperCase *)
  78.     len := length(instring) ;
  79.     for ix := 1 to len do instring[ix] := Upcase(instring[ix]);
  80.     UpperCase := instring ;
  81.     End ; (* UpperCase *)
  82.  
  83. (* ----------------------------------------------------------------- *)
  84. (* Prefixof Function - Returns a char string of the dir prefix.      *)
  85. (* ----------------------------------------------------------------- *)
  86.  function Prefixof(afilename:String) : String;
  87.  var i :integer;
  88.  label exit ;
  89.     begin (* Prefixof *)
  90.     while length(afilename)>0 do
  91.          If afilename[length(afilename)] in [':','\','/']
  92.              then goto exit
  93.              else delete(afilename,length(afilename),1);
  94.  exit:
  95.     Prefixof := afilename ;
  96.     end;  (* Prefixof *)
  97.  
  98. (* ----------------------------------------------------------------- *)
  99. (*  NewAsFile - returns a new ASFILE name in the parameter AsFile.   *)
  100. (*           MyFiles - is the wild char name.                        *)
  101. (*           Filename - is the filename to be renamed .              *)
  102. (*           AsFiles  - is the wild char name of new file.           *)
  103. (*           AsFile   - is the new file name.                        *)
  104. (*     returns TRUE if AsFile correctly assigned.                    *)
  105. (*     returns FALSE if AsFile detected an error in assignment       *)
  106. (*   There is a BUG in the MsDoS Call to get next Directory Entry    *)
  107. (*   therefore this function may return FALSE.                       *)
  108. (*                                                                   *)
  109. (* ----------------------------------------------------------------- *)
  110. Function NewAsFile (MyFiles,Filename,AsFiles: String ;
  111.                                  var AsFile : String ): boolean;
  112. var
  113.     temp     : String ;
  114.     si,ix,iy : integer ;
  115.     star     : packed array[1..8] of string[20];
  116. Label  Subdir,Subdir1,Exit;
  117.  
  118. Begin (* NewAsFile Function *)
  119. for si := 1 to 8 do star[si] := '*';
  120. si := 0 ;
  121.  MyFiles  := Uppercase(Myfiles);
  122.  FileName := Uppercase(Filename);
  123.  AsFiles  := Uppercase(AsFiles);
  124.  ix := Pos(':',MyFiles) ;
  125.  If ix > 1 then delete(MyFiles,1,ix) ;  (* Eliminate filemode prefix *)
  126. subdir:
  127.  ix := Pos('\',MyFiles) ;
  128.  If ix > 0 then delete(MyFiles,1,ix) ;  (* Eliminate sub-dir  prefixs *)
  129.  if ix > 0 then goto subdir ;
  130.  ix := Pos(':',AsFiles) ;
  131.  If ix > 1 then delete(AsFiles,1,ix) ;  (* Eliminate filemode prefix *)
  132. subdir1:
  133.  ix := Pos('\',AsFiles) ;
  134.  If ix > 0 then delete(AsFiles,1,ix) ;  (* Eliminate sub-dir  prefixs *)
  135.  if ix > 0 then goto subdir1 ;
  136. While (length(Filename) > 0) and (length(Myfiles)>0) Do
  137.     Begin (* Scan filename *)
  138.     If MyFiles[1] = Filename[1] then
  139.         Begin delete(MyFiles,1,1) ; delete(Filename,1,1); end
  140.                                 else
  141.          Begin (* get star string *)
  142.          si:=si+1 ;
  143.          delete(MyFiles,1,1);
  144.          ix := Pos('*',MyFiles) - 1 ;  (* Next wild char *)
  145.          if ix <= 0 then  temp := MyFiles
  146.                     else  temp := copy(Myfiles,1,ix);
  147.          iy := Pos(temp,Filename)-1 ;
  148.          if iy < 0 then
  149.               begin NEWASFILE:=FALSE; Asfile:='temp.dat'; Goto exit ; end;
  150.          if iy = 0 then star[si] := filename
  151.                     else star[si] := copy(filename,1,iy);
  152.          delete(FileName,1,iy);
  153.          End ;(* get star string *)
  154.     End; (* Scan filename *)
  155. ix := 1 ;
  156. si := 1 ;
  157. AsFile := '';
  158. While ix <= length(AsFiles)  do
  159.     Begin (* Create AsFile name *)
  160.     If AsFiles[ix] in ['*','?'] then
  161.          Begin (* wild char *)
  162.          AsFile := Concat(AsFile,star[si]);
  163.          si := si + 1 ;
  164.          End
  165.                                 else
  166.         AsFile := Concat(AsFile,Asfiles[ix]);
  167.    ix := ix + 1 ;
  168.    End ; (* Create AsFile name *)
  169. NewAsFile := True ;
  170. Exit:
  171. End; (* NewASFile Function *)
  172.  
  173. Begin (* KGlobals *)
  174.  (* Default Settings *)
  175.     XonXoff    := False ;
  176.     NoEcho     := True ;
  177.     LocalEcho  := False ;
  178.     AudioFlag  := False ;
  179.     AplFlag    := False ;
  180.     ParmFlag   := False ;
  181.     Line25Flag := True ;
  182.  
  183. (*  Execution control flags *)
  184.     Running    := true ;
  185.     connected  := false ;
  186.     logging    := false ;
  187.     ForPrinter := false ;
  188.     TakeActive := false ;
  189.     GotSOH     := false ;
  190.     WaitXon    := false ;
  191. End. (* KGlobals *)
  192.