Модификация настроек BDE
Falk0ner, вс, 06/07/2008 - 15:34.
Is there a way to change the IDAPI.CFG file from Delphi coding using the BDE API, since I wish to avoid having my users utilize the BDECFG.EXE utility?
Answer:
Here is a unit that is supposed to allow changing the config file:
unit CFGTOOL;
interface
uses
SysUtils, Classes, DB, DbiProcs, DbiTypes, DbiErrs;
type
TBDEConfig = class(TComponent)
private
FLocalShare: Boolean;
FMinBufSize: Integer;
FMaxBufSize: Integer;
FSystemLangDriver: string;
FParadoxLangDriver: string;
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, '\SYSTEM\INIT', h));
GetMem(pCfgDes, sizeof(CFGDesc));
try
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetRecord(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,
'\DRIVERS\PARADOX\INIT', h));
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetRecord(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,
'\DRIVERS\PARADOX\TABLE CREATE', h));
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetRecord(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('\SYSTEM\INIT', 'LOCAL SHARE', BooleanToStr(Value));
FLocalShare := Value;
end;
procedure TBDEConfig.SetMinBufSize(Value: Integer);
begin
UpdateCfgFile('\SYSTEM\INIT', 'MINBUFSIZE', IntToStr(Value));
FMinBufSize := Value;
end;
procedure TBDEConfig.SetMaxBufSize(Value: Integer);
begin
UpdateCfgFile('\SYSTEM\INIT', 'MAXBUFSIZE', IntToStr(Value));
FMaxBufSize := Value;
end;
procedure TBDEConfig.SetSystemLangDriver(Value: string);
begin
UpdateCfgFile('\SYSTEM\INIT', 'LANGDRIVER', Value);
FSystemLangDriver := Value;
end;
procedure TBDEConfig.SetParadoxLangDriver(Value: string);
begin
UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'LANGDRIVER', Value);
FParadoxLangDriver := Value;
end;
procedure TBDEConfig.SetMaxFileHandles(Value: Integer);
begin
UpdateCfgFile('\SYSTEM\INIT', 'MAXFILEHANDLES', IntToStr(Value));
FMaxFileHandles := Value;
end;
procedure TBDEConfig.SetNetFileDir(Value: string);
begin
UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'NET DIR', Value);
FNetFileDir := Value;
end;
procedure TBDEConfig.SetTableLevel(Value: string);
begin
UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'LEVEL', Value);
FTableLevel := Value;
end;
procedure TBDEConfig.SetBlockSize(Value: Integer);
begin
UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'BLOCK SIZE', IntToStr(Value));
FBlockSize := Value;
end;
procedure TBDEConfig.SetStrictIntegrity(Value: Boolean);
begin
UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'STRICTINTEGRITY',
BooleanToStr(Value));
FStrictIntegrity := Value;
end;
procedure TBDEConfig.SetDefaultDriver(Value: string);
begin
UpdateCfgFile('\SYSTEM\INIT', 'DEFAULT DRIVER', Value);
FDefaultDriver := Value;
end;
procedure TBDEConfig.SetAutoODBC(Value: Boolean);
begin
UpdateCfgFile('\SYSTEM\INIT', '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 (DbiGetRecord(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.
interface
uses
SysUtils, Classes, DB, DbiProcs, DbiTypes, DbiErrs;
type
TBDEConfig = class(TComponent)
private
FLocalShare: Boolean;
FMinBufSize: Integer;
FMaxBufSize: Integer;
FSystemLangDriver: string;
FParadoxLangDriver: string;
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, '\SYSTEM\INIT', h));
GetMem(pCfgDes, sizeof(CFGDesc));
try
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetRecord(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,
'\DRIVERS\PARADOX\INIT', h));
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetRecord(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,
'\DRIVERS\PARADOX\TABLE CREATE', h));
FillChar(pCfgDes^, sizeof(CFGDesc), #0);
while (DbiGetRecord(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('\SYSTEM\INIT', 'LOCAL SHARE', BooleanToStr(Value));
FLocalShare := Value;
end;
procedure TBDEConfig.SetMinBufSize(Value: Integer);
begin
UpdateCfgFile('\SYSTEM\INIT', 'MINBUFSIZE', IntToStr(Value));
FMinBufSize := Value;
end;
procedure TBDEConfig.SetMaxBufSize(Value: Integer);
begin
UpdateCfgFile('\SYSTEM\INIT', 'MAXBUFSIZE', IntToStr(Value));
FMaxBufSize := Value;
end;
procedure TBDEConfig.SetSystemLangDriver(Value: string);
begin
UpdateCfgFile('\SYSTEM\INIT', 'LANGDRIVER', Value);
FSystemLangDriver := Value;
end;
procedure TBDEConfig.SetParadoxLangDriver(Value: string);
begin
UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'LANGDRIVER', Value);
FParadoxLangDriver := Value;
end;
procedure TBDEConfig.SetMaxFileHandles(Value: Integer);
begin
UpdateCfgFile('\SYSTEM\INIT', 'MAXFILEHANDLES', IntToStr(Value));
FMaxFileHandles := Value;
end;
procedure TBDEConfig.SetNetFileDir(Value: string);
begin
UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'NET DIR', Value);
FNetFileDir := Value;
end;
procedure TBDEConfig.SetTableLevel(Value: string);
begin
UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'LEVEL', Value);
FTableLevel := Value;
end;
procedure TBDEConfig.SetBlockSize(Value: Integer);
begin
UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'BLOCK SIZE', IntToStr(Value));
FBlockSize := Value;
end;
procedure TBDEConfig.SetStrictIntegrity(Value: Boolean);
begin
UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'STRICTINTEGRITY',
BooleanToStr(Value));
FStrictIntegrity := Value;
end;
procedure TBDEConfig.SetDefaultDriver(Value: string);
begin
UpdateCfgFile('\SYSTEM\INIT', 'DEFAULT DRIVER', Value);
FDefaultDriver := Value;
end;
procedure TBDEConfig.SetAutoODBC(Value: Boolean);
begin
UpdateCfgFile('\SYSTEM\INIT', '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 (DbiGetRecord(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.
Problem/Question/Abstract:
How can my program access the idapi.cfg file and probably change its INIT (Local Share etc.) section?
Answer:
For 32bit only. You can of course use the registry to determine the default CFG File instead of passing it as a parameter here:
procedure ModifyCFG(const ACFGFile, AValue, AEntry, ACFGPath: string; SaveAsWin31:
bool);
var
hCfg: hDBICfg;
pRecBuf, pTmpRec: pByte;
pFields: pFLDDesc;
Count: word;
i: integer;
Save: boolean;
Reg: TRegistry;
const
RegSaveWIN31: array[bool] of string = ('WIN32', 'WIN31');
begin
hCfg := nil;
pFields := nil;
pRecBuf := nil;
Save := False;
Check(DbiOpenConfigFile(PChar(ACFGFile), False, hCfg));
try
Check(DbiCfgPosition(hCfg, PChar(ACfgPath))); {neccessary...?}
Check(DbiCfgGetRecord(hCfg, PChar(ACfgPath), Count, nil, nil));
pRecBuf := AllocMem(succ(Count) * 128); {128 additional safety...}
pFields := AllocMem(Count * sizeof(FLDDesc));
Check(DbiCfgGetRecord(hCfg, PChar(ACfgPath), Count, pFields, pRecBuf));
for i := 1 to Count do
begin
if StrPas(pFields^.szName) = AEntry then
begin
pTmpRec := pRecBuf;
Inc(pTmpRec, 128 * (i - 1));
StrPCopy(PChar(pTmpRec), AValue);
end;
inc(pFields);
end;
dec(pFields, Count);
Check(DbiCfgModifyRecord(hCfg, PChar(ACfgPath), Count, pFields, pRecBuf));
Save := True;
finally
if hCfg <> nil then
Check(DbiCloseConfigFile(hCfg, Save, True, SaveAsWin31));
if pRecBuf <> nil then
FreeMem(pRecBuf, succ(Count) * 128);
if pFields <> nil then
FreeMem(pFields, Count * sizeof(FLDDesc));
end;
{update registry SAVECONFIG value}
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if not Reg.OpenKey('SOFTWARE\Borland\Database Engine', False) then
ShowMessage('Configuration Path not found')
else
begin
Reg.LazyWrite := False;
Reg.WriteString('SAVECONFIG', RegSaveWIN31[SaveAsWin31]);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
{DbiExit/Init to re-read cfg... make absolutely sure there are no active
DB components when doing this (it's is best done by a loader app)}
Session.Close;
Session.Open;
end;
bool);
var
hCfg: hDBICfg;
pRecBuf, pTmpRec: pByte;
pFields: pFLDDesc;
Count: word;
i: integer;
Save: boolean;
Reg: TRegistry;
const
RegSaveWIN31: array[bool] of string = ('WIN32', 'WIN31');
begin
hCfg := nil;
pFields := nil;
pRecBuf := nil;
Save := False;
Check(DbiOpenConfigFile(PChar(ACFGFile), False, hCfg));
try
Check(DbiCfgPosition(hCfg, PChar(ACfgPath))); {neccessary...?}
Check(DbiCfgGetRecord(hCfg, PChar(ACfgPath), Count, nil, nil));
pRecBuf := AllocMem(succ(Count) * 128); {128 additional safety...}
pFields := AllocMem(Count * sizeof(FLDDesc));
Check(DbiCfgGetRecord(hCfg, PChar(ACfgPath), Count, pFields, pRecBuf));
for i := 1 to Count do
begin
if StrPas(pFields^.szName) = AEntry then
begin
pTmpRec := pRecBuf;
Inc(pTmpRec, 128 * (i - 1));
StrPCopy(PChar(pTmpRec), AValue);
end;
inc(pFields);
end;
dec(pFields, Count);
Check(DbiCfgModifyRecord(hCfg, PChar(ACfgPath), Count, pFields, pRecBuf));
Save := True;
finally
if hCfg <> nil then
Check(DbiCloseConfigFile(hCfg, Save, True, SaveAsWin31));
if pRecBuf <> nil then
FreeMem(pRecBuf, succ(Count) * 128);
if pFields <> nil then
FreeMem(pFields, Count * sizeof(FLDDesc));
end;
{update registry SAVECONFIG value}
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if not Reg.OpenKey('SOFTWARE\Borland\Database Engine', False) then
ShowMessage('Configuration Path not found')
else
begin
Reg.LazyWrite := False;
Reg.WriteString('SAVECONFIG', RegSaveWIN31[SaveAsWin31]);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
{DbiExit/Init to re-read cfg... make absolutely sure there are no active
DB components when doing this (it's is best done by a loader app)}
Session.Close;
Session.Open;
end;
ACFGPath would be '\SYSTEM\INIT\', AEntry would be 'LOCAL SHARE' und AValue would be 'TRUE' or 'FALSE'.
Взято с Delphi Knowledge Base: http://www.baltsoft.com/
Отправить комментарий