home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l041 / 2.ddi / MISC.ARC / CONFIG.PAS next >
Encoding:
Pascal/Delphi Source File  |  1987-12-31  |  3.3 KB  |  122 lines

  1. (****************************************************************)
  2. (*                     DATABASE TOOLBOX 4.0                     *)
  3. (*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
  4. (*                                                              *)
  5. (*                     Configuration Unit                       *)
  6. (*                                                              *)
  7. (*  Purpose: Used to install TABuild                            *)
  8. (*                                                              *)
  9. (****************************************************************)
  10. unit Config;
  11.  
  12. interface
  13. uses CRT;
  14.  
  15. type
  16.   CFGFileName = string[66];
  17.  
  18. procedure CFGAbort (msg: String);
  19.  
  20. function CFGExist(FN : CFGFileName) : boolean;
  21.  
  22. procedure CFGReplace (fn: CFGFileName; var head, tail;
  23.                       Load : boolean);
  24.  
  25. implementation
  26.  
  27. {$V-}
  28.  
  29. procedure CFGAbort (msg: String);
  30. begin
  31.   GotoXY(1, 25);
  32.   writeln;
  33.   writeln('Abort -- ', msg);
  34.   Halt
  35. end {CFGAbort};
  36.  
  37. function UpCaseStr(S : String) : String;
  38. var
  39.   i : integer;
  40. begin
  41.   for i := 1 to length(S) do
  42.     S[i] := UpCase(S[i]);
  43.   UpCaseStr := S;
  44. end; { UpCaseStr }
  45.  
  46. function CFGExist(FN : CFGFileName) : boolean;
  47. var
  48.   F : file;
  49.   found : boolean;
  50. begin
  51.   Assign(f, FN);
  52.   {$I-}
  53.   Reset(f);
  54.   Found := (IOResult = 0);
  55.   if Found then
  56.     Close(f);
  57.   {$I+}
  58.   CFGExist := Found;
  59. end; { CFGExist }
  60.  
  61. {$F+}
  62. function Search(var Buffer; BufLength : Word; St : String) : Word; external;
  63. {-Search through Buffer for St. BufLength is length of range to search}
  64. {$L SEARCH}
  65. {$F-}
  66.  
  67. procedure CFGReplace (fn: CFGFileName; var head, tail;
  68.                       Load : boolean);
  69. type
  70.   buffer = array[1..$7FFF] of Byte;
  71. var
  72.   data: array[0..256] of Byte absolute head;
  73.   source: string[255] absolute head;
  74.   bufPtr: ^buffer;
  75.   len, searchLen: Byte;
  76.   bufLen : LongInt;
  77.   inBuf, i, actual, amount, result: word;
  78.   pos: LongInt;
  79.   f: File;
  80. begin
  81.   len := Length(source);
  82.   searchLen := Pred(len);
  83.   bufLen := MaxAvail;
  84.   if bufLen > SizeOf(buffer) then
  85.     bufLen := SizeOf(buffer);
  86.   if bufLen < len then
  87.     CFGAbort('CFGReplace: Not enough available heap space');
  88.   GetMem(bufPtr, bufLen);
  89.   Assign(f, fn);
  90.   {$I-} Reset(f, 1); {$I+}
  91.   if IOresult <> 0 then CFGAbort('CFGReplace: Unable to open "' + fn + '"');
  92.   BlockRead(f, bufPtr^, bufLen, actual);
  93.   pos := actual;
  94.   i := Search(bufPtr^, actual, source);
  95.   while (i = 0) and (actual >= len) do
  96.     begin
  97.       Move(bufPtr^[Succ(actual - searchLen)], bufPtr^[1], searchLen);
  98.       BlockRead(f, bufPtr^[len], bufLen - searchLen, actual);
  99.       pos := pos + actual;
  100.       actual := actual + searchLen;
  101.       i := Search(bufPtr^, actual, source)
  102.     end;
  103.   FreeMem(bufPtr, bufLen);
  104.   if i <> 0 then Seek(f, pos + i + searchLen - actual)
  105.   else CFGAbort('CFGReplace: Cannot find header string in file');
  106.   amount := Ofs(tail) - Ofs(data[Succ(len)]);
  107.   if Load then
  108.   begin
  109.     BlockRead(f, data[Succ(len)], amount, result);
  110.     if result <> amount then
  111.       CFGAbort('CFGReplace: Unable to load data');
  112.   end
  113.   else
  114.   begin
  115.     BlockWrite(f, data[Succ(len)], amount, result);
  116.     if result <> amount then CFGAbort('CFGReplace: Unable to write data');
  117.   end;
  118.   Close(f)
  119. end {CFGReplace};
  120.  
  121. end. { Config }
  122.