Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
FMaxFileHandles : Integer;
FNetFileDir : String;
FTableLevel : String;
FBlockSize : Integer;
FDefaultDriver : String;
FStrictIntegrity : Boolean;
FAutoODBC : Boolean;
procedure Init;
procedure SetLocalShare(Value : Boolean);
procedure SetMinBufSize(Value : Integer);
procedure SetMaxBufSize(Value : Integer);
procedure SetSystemLangDriver(Value : String);
procedure SetParadoxLangDriver(Value : String);
procedure SetMaxFileHandles(Value : Integer);
procedure SetNetFileDir(Value : String);
procedure SetTableLevel(Value : String);
procedure SetBlockSize(Value : Integer);
procedure SetDefaultDriver(Value : String);
procedure SetAutoODBC(Value : Boolean);
procedure SetStrictIntegrity(Value : Boolean);
procedure UpdateCFGFile(path, item, value : string);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property LocalShare : Boolean read FLocalShare write SetLocalShare;
property MinBufSize : Integer read FMinBufSize write SetMinBufSize;
property MaxBufSize : Integer read FMaxBufSize write SetMaxBufSize;
property SystemLangDriver : String read FSystemLangDriver write SetSystemLangDriver;
property ParadoxLangDriver : String read FParadoxLangDriver write SetParadoxLangDriver;
property MaxFileHandles : Integer read FMaxFileHandles write SetMaxFileHandles;
property NetFileDir : String read FNetFileDir write SetNetFileDir;
property TableLevel : String read FTableLevel write SetTableLevel;
property BlockSize : Integer read FBlockSize write SetBlockSize;
property DefaultDriver : string read FDefaultDriver write SetDefaultDriver;
property AutoODBC : Boolean read FAutoODBC write SetAutoODBC;
property StrictIntegrity : Boolean read FStrictIntegrity write SetStrictIntegrity;
end;
procedure Register;
implementation
function StrToBoolean(Value : string) : Boolean;
begin
if (UpperCase(Value) = 'TRUE') or (UpperCase(Value) = 'ON') or (UpperCase(Value) = 'YES') or (UpperCase(Value) = '.T.' ) then Result := True
else Result := False;
end;
function BooleanToStr(Value : Boolean) : String;
begin
if Value then Result := 'TRUE'
else Result := 'FALSE';
end;
procedure Register;
begin
RegisterComponents('Data Access', [TBDEConfig]);
end;
procedure TBDEConfig.Init;
var
h: hDBICur;
pCfgDes: pCFGDesc;
n, v : string;
begin
Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent,'SYSTEMINIT', h));
GetMem(pCfgDes, sizeof(CFGDesc));
try
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
n := StrPas(pCfgDes^.szNodeName);
v := StrPas(pCfgDes^.szValue);
if n = 'LOCAL SHARE' then FLocalShare := StrToBoolean(v)
else if n = 'MINBUFSIZE' then FMinBufSize := StrToInt(v)
else if n = 'MAXBUFSIZE' then FMaxBufSize := StrToInt(v)
else if n = 'MAXFILEHANDLES' then FMaxFileHandles := StrToInt(v)
else if n = 'LANGDRIVER' then FSystemLangDriver := v
else if n = 'AUTO ODBC' then FAutoODBC := StrToBoolean(v)
else if n = 'DEFAULT DRIVER' then FDefaultDriver := v;
end;
if (h <> nil) then DbiCloseCursor(h);
Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent,'DRIVERSPARADOXINIT', h));
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
n := StrPas(pCfgDes^.szNodeName);
v := StrPas(pCfgDes^.szValue);
if n = 'NET DIR' then FNetFileDir := v
else if n = 'LANGDRIVER' then FParadoxLangDriver := v;
end;
if (h <> nil) then DbiCloseCursor(h);
Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent, 'DRIVERSPARADOXTABLE CREATE', h));
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
n := StrPas(pCfgDes^.szNodeName);
v := StrPas(pCfgDes^.szValue);
if n = 'LEVEL' then FTableLevel := v
else if n = 'BLOCK SIZE' then FBlockSize := StrToInt(v)
else if n = 'STRICTINTEGRITY' then FStrictIntegrity := StrToBoolean(v);
end;
finally
FreeMem(pCfgDes, sizeof(CFGDesc));
if (h <> nil) then DbiCloseCursor(h);
end;
end;
procedure TBDEConfig.SetLocalShare(Value : Boolean);
begin
UpdateCfgFile('SYSTEMINIT', 'LOCAL SHARE', BooleanToStr(Value));
FLocalShare := Value;
end;
procedure TBDEConfig.SetMinBufSize(Value : Integer);
begin
UpdateCfgFile('SYSTEMINIT', 'MINBUFSIZE', IntToStr(Value));
FMinBufSize := Value;
end;
procedure TBDEConfig.SetMaxBufSize(Value : Integer);
begin
UpdateCfgFile('SYSTEMINIT', 'MAXBUFSIZE', IntToStr(Value));
FMaxBufSize := Value;
end;
procedure TBDEConfig.SetSystemLangDriver(Value : String);
begin
UpdateCfgFile('SYSTEMINIT', 'LANGDRIVER', Value);
FSystemLangDriver := Value;
end;
procedure TBDEConfig.SetParadoxLangDriver(Value : String);
begin
UpdateCfgFile('DRIVERSPARADOXINIT', 'LANGDRIVER', Value);
FParadoxLangDriver := Value;
end;
procedure TBDEConfig.SetMaxFileHandles(Value : Integer);
begin
UpdateCfgFile('SYSTEMINIT', 'MAXFILEHANDLES', IntToStr(Value));
FMaxFileHandles := Value;
end;
procedure TBDEConfig.SetNetFileDir(Value : String);
begin
UpdateCfgFile('DRIVERSPARADOXINIT', 'NET DIR', Value);
FNetFileDir := Value;
end;
procedure TBDEConfig.SetTableLevel(Value : String);
begin
UpdateCfgFile('DRIVERSPARADOXTABLE CREATE', 'LEVEL', Value);
FTableLevel := Value;
end;
procedure TBDEConfig.SetBlockSize(Value : Integer);
begin
UpdateCfgFile('DRIVERSPARADOXTABLE CREATE', 'BLOCK SIZE', IntToStr(Value));
FBlockSize := Value;
end;
procedure TBDEConfig.SetStrictIntegrity(Value : Boolean);
begin
UpdateCfgFile('DRIVERSPARADOXTABLE CREATE', 'STRICTINTEGRITY', BooleanToStr(Value));
FStrictIntegrity := Value;
end;
procedure TBDEConfig.SetDefaultDriver(Value : String);
begin
UpdateCfgFile('SYSTEMINIT', 'DEFAULT DRIVER', Value);
FDefaultDriver := Value;
end;
procedure TBDEConfig.SetAutoODBC(Value : Boolean);
begin
UpdateCfgFile('SYSTEMINIT', 'AUTO ODBC', BooleanToStr(Value));
FAutoODBC := Value;
end;
procedure TBDEConfig.UpdateCFGFile;
var
h : hDbiCur;
pCfgDes: pCFGDesc;
pPath : array[0..127] of char;
begin
StrPCopy(pPath,Path);
Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent, pPath, h));
GetMem(pCfgDes, sizeof(CFGDesc));
try
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
if StrPas(pCfgDes^.szNodeName) = item then begin
StrPCopy(pCfgDes^.szValue, value);
Check(DbiModifyRecord(h, pCfgDes, True));
end;
end;
finally
FreeMem(pCfgDes, sizeof(CFGDesc));
if (h <> nil) then DbiCloseCursor(h);
end;
end;
constructor TBDEConfig.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Init;
end;
destructor TBDEConfig.Destroy;
begin
inherited Destroy;
end;
end.
