Модификация настроек 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/