home *** CD-ROM | disk | FTP | other *** search
- (****************************************************************)
- (* DATABASE TOOLBOX 4.0 *)
- (* Copyright (c) 1984, 87 by Borland International, Inc. *)
- (* *)
- (* Configuration Unit *)
- (* *)
- (* Purpose: Used to install TABuild *)
- (* *)
- (****************************************************************)
- unit Config;
-
- interface
- uses CRT;
-
- type
- CFGFileName = string[66];
-
- procedure CFGAbort (msg: String);
-
- function CFGExist(FN : CFGFileName) : boolean;
-
- procedure CFGReplace (fn: CFGFileName; var head, tail;
- Load : boolean);
-
- implementation
-
- {$V-}
-
- procedure CFGAbort (msg: String);
- begin
- GotoXY(1, 25);
- writeln;
- writeln('Abort -- ', msg);
- Halt
- end {CFGAbort};
-
- function UpCaseStr(S : String) : String;
- var
- i : integer;
- begin
- for i := 1 to length(S) do
- S[i] := UpCase(S[i]);
- UpCaseStr := S;
- end; { UpCaseStr }
-
- function CFGExist(FN : CFGFileName) : boolean;
- var
- F : file;
- found : boolean;
- begin
- Assign(f, FN);
- {$I-}
- Reset(f);
- Found := (IOResult = 0);
- if Found then
- Close(f);
- {$I+}
- CFGExist := Found;
- end; { CFGExist }
-
- {$F+}
- function Search(var Buffer; BufLength : Word; St : String) : Word; external;
- {-Search through Buffer for St. BufLength is length of range to search}
- {$L SEARCH}
- {$F-}
-
- procedure CFGReplace (fn: CFGFileName; var head, tail;
- Load : boolean);
- type
- buffer = array[1..$7FFF] of Byte;
- var
- data: array[0..256] of Byte absolute head;
- source: string[255] absolute head;
- bufPtr: ^buffer;
- len, searchLen: Byte;
- bufLen : LongInt;
- inBuf, i, actual, amount, result: word;
- pos: LongInt;
- f: File;
- begin
- len := Length(source);
- searchLen := Pred(len);
- bufLen := MaxAvail;
- if bufLen > SizeOf(buffer) then
- bufLen := SizeOf(buffer);
- if bufLen < len then
- CFGAbort('CFGReplace: Not enough available heap space');
- GetMem(bufPtr, bufLen);
- Assign(f, fn);
- {$I-} Reset(f, 1); {$I+}
- if IOresult <> 0 then CFGAbort('CFGReplace: Unable to open "' + fn + '"');
- BlockRead(f, bufPtr^, bufLen, actual);
- pos := actual;
- i := Search(bufPtr^, actual, source);
- while (i = 0) and (actual >= len) do
- begin
- Move(bufPtr^[Succ(actual - searchLen)], bufPtr^[1], searchLen);
- BlockRead(f, bufPtr^[len], bufLen - searchLen, actual);
- pos := pos + actual;
- actual := actual + searchLen;
- i := Search(bufPtr^, actual, source)
- end;
- FreeMem(bufPtr, bufLen);
- if i <> 0 then Seek(f, pos + i + searchLen - actual)
- else CFGAbort('CFGReplace: Cannot find header string in file');
- amount := Ofs(tail) - Ofs(data[Succ(len)]);
- if Load then
- begin
- BlockRead(f, data[Succ(len)], amount, result);
- if result <> amount then
- CFGAbort('CFGReplace: Unable to load data');
- end
- else
- begin
- BlockWrite(f, data[Succ(len)], amount, result);
- if result <> amount then CFGAbort('CFGReplace: Unable to write data');
- end;
- Close(f)
- end {CFGReplace};
-
- end. { Config }