Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Модификация настроек BDE

01.01.2007

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 (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,
     
'\DRIVERS\PARADOX\INIT', 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,
     
'\DRIVERS\PARADOX\TABLE 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('\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 (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.

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;

ACFGPath would be '\SYSTEM\INIT\', AEntry would be 'LOCAL SHARE' und AValue would be 'TRUE' or 'FALSE'.

Взято с Delphi Knowledge Base: https://www.baltsoft.com/