BDE, IDAPI32.CFG modification par programme

Bonjour,

d'après vous est-il possible de modifier IDAPI32.CFG par programme (et sans les composants BDE, du moins sans utiliser de composants BDE comme Session etc.. <<< contrainte) ?

La problématique : de vieilles applications utilisent encore BDE pour accéder à une base Firebird je veux, après avoir détecté si le poste client se trouve sur le réseau local ou pas pouvoir changer l'alias si besoin

Voilà, en gros, le code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

var Response : IHttpResponse; IP : String; RegEx : TREgEx; IniFile : TInifile; IniFileName : String; begin // récupération de l'adresse IP internet Response:=NetHttpClient1.Get('http://checkip.dyndns.org/'); RegEx:=TRegEx.Create('(?<IPV4>\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})'); if RegEx.Match(Response.ContentAsString).Success then IP:=RegEx.Match(Response.ContentAsString).Value; Caption:=Format('Adresse Internet %s',[IP]); // récupération settings IniFileName:=TPath.Combine(TPath.GetHomePath,'Gpao'); Forcedirectories(IniFileName); IniFileName:=TPath.Combine(IniFileName,'Settings.ini'); IniFile:=TIniFile.Create(IniFileName); with IniFile do begin IPLocale:=ReadString('Adresse','FAI','xxx.xxx.xxx.xxx'); IPFirebird:=ReadString('Adresse','Serveur','192.168.1.46'); end;   // Changer l'alias si besoin // Lire et changer l'alias // si IPLocale=IP alors Alias=IPFireBird:Base // sinon Alias=IPLocale:Base;

---

Il doit y avoir moyen de modifier le fichier IDAPI32.CFG (en faisant attention aux problèmes d'UAC) de plusieurs façons (ReplaceStr, expressions régulières RegEx.replace).
:arrow: En voyez-vous d'autres ?
:arrow: Avez vous déjà essayé ?

Je vais regarder dans mes archives

Bonjour,

J'ai avancé ou du moins ai-je lis de l'eau dans mon vin en installant quand même les packages BDE et ce pour justement accéder à BDE.pas et les fonctions Dbixxxxxx, malheureusement je me fait jeter comme un malpropre dès le DbiInit !

Code:

---

1 2 3 4 5 6 7 8 9 10 11

procedure Check(Error: Integer); begin if Error <> 0 then raise Exception.CreateFmt('BDE Error #%.4x', [Error]); end;   procedure TwndMain.FormCreate(Sender: TObject); begin Check(DbiInit(nil)); // FillTree(TreeView1.Items.AddChild(nil, 'BDE'), '\'); end;

---

À mon avis, en étudiant la structure d'un idapi32.cfg, je ferais mieux de remplir un arbre en lisant caractère par caractère :roll:

Code en Delphi 7

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309

// MFDev - 03/2006 - v0.8 // Gestion du BDE UNIT BdeInit;   INTERFACE uses SysUtils, StrUtils, Dialogs, Forms, Registry, Windows, Classes, DbTables;   function Test_BDE(sDirEXE: string; Table: TTable): boolean; function BDEExist: boolean;   IMPLEMENTATION const csBDEDir = 'SOFTWARE\Borland\Database Engine'; // HKLM csBDEDirFormat = 'Software\Borland\Database Engine\Settings\System\FORMATS'; csBDEDirDriver = 'Software\Borland\Database Engine\Settings\DRIVERS\PARADOX'; csNetDir = 'NET DIR'; csCfg = 'IDAPI32.CFG'; csHKU = 'HKU';   // write Key in Registry function bWriteStringReg(const csRoot, csClef, csSection: string; sValeur: string): boolean; var Reg: TRegistry; begin // ex: bEcrireString('\Demarrage', 'Tranche', sChaine) Result := false; Reg := TRegistry.Create; TRY if csRoot <> csHKU then Reg.RootKey := HKEY_LOCAL_MACHINE; // true pour la créer si elle n'existe pas if Reg.OpenKey(csClef, true) then begin Reg.WriteString(csSection, sValeur); Result := true; end; FINALLY Reg.CloseKey; Reg.Free; END; end;   // Exist BDE in Registry function BDEExist: boolean; var Reg: TRegistry; sFileIdapi: string; begin Result := false; Reg := TRegistry.Create; with Reg do begin RootKey := HKEY_LOCAL_MACHINE; OpenKey('SOFTWARE\Borland\Database Engine', False); TRY sFileIdapi := ReadString('CONFIGFILE01'); // BDE installed if sFileIdapi <> '' then begin if FileExists(sFileIdapi) then Result := true; // force NetDir = Dir BDE sFileIdapi := ReadString('DLLPATH'); bWriteStringReg('', csBDEDirDriver + '\INIT', csNetDir, sFileIdapi); end; FINALLY CloseKey; Free; END; end; // with end;   // Init Registry function BDE_Init(sDir: string): boolean; begin Session.NetFiledir := sDir; // sNetDir; TRY bWriteStringReg('', csBDEDir, 'DLLPATH', sDir); bWriteStringReg('', csBDEDir, 'CONFIGFILE01', sDir + '\' + csCfg); bWriteStringReg('', csBDEDir, 'SAVECONFIG', 'WIN31'); bWriteStringReg('', csBDEDir, 'UseCount', '1'); bWriteStringReg('', csBDEDir, 'RESOURCE', '000C'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'LOCAL SHARE', 'FALSE'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'VERSION', '3.0'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'MINBUFSIZE', '512'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'MAXBUFSIZE', '4096'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'LANGDRIVER', 'intl'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'MAXFILEHANDLES', '48'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'SYSFLAGS', '0'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'LOW MEMORY USAGE LIMIT', '64'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'AUTO ODBC', 'FALSE'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'DEFAULT DRIVER', 'PARADOX'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'SHAREDMEMSIZE', '4096'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'SHAREDMEMLOCATION', ''); bWriteStringReg('', csBDEDirFormat + '\INIT', 'DATA REPOSITORY', ''); bWriteStringReg('', csBDEDirFormat + '\INIT', 'MEMSIZE', '32'); bWriteStringReg('', csBDEDirFormat + '\INIT', 'SQLQRYMODE', ''); bWriteStringReg('', csBDEDirFormat + '\INIT', 'MTS POOLING', 'FALSE');   bWriteStringReg('', csBDEDirFormat + '\DATE', 'MTS POOLING', 'FALSE'); bWriteStringReg('', csBDEDirFormat + '\DATE', 'SEPARATOR', '/'); bWriteStringReg('', csBDEDirFormat + '\DATE', 'MODE', '1'); bWriteStringReg('', csBDEDirFormat + '\DATE', 'FOURDIGITYEAR', 'TRUE'); bWriteStringReg('', csBDEDirFormat + '\DATE', 'YEARBIASED', 'FALSE'); bWriteStringReg('', csBDEDirFormat + '\DATE', 'LEADINGZEROM', 'TRUE'); bWriteStringReg('', csBDEDirFormat + '\DATE', 'LEADINGZEROD', 'TRUE');   bWriteStringReg('', csBDEDirFormat + '\TIME', 'TWELVEHOUR', 'FALSE'); bWriteStringReg('', csBDEDirFormat + '\TIME', 'AMSTRING', 'AM'); bWriteStringReg('', csBDEDirFormat + '\TIME', 'PMSTRING', 'PM'); bWriteStringReg('', csBDEDirFormat + '\TIME', 'SECONDS', 'TRUE'); bWriteStringReg('', csBDEDirFormat + '\TIME', 'MILSECONDS', 'FALSE');   bWriteStringReg('', csBDEDirFormat + '\NUMBER', 'DECIMALSEPARATOR', '.'); bWriteStringReg('', csBDEDirFormat + '\NUMBER', 'THOUSANDSEPARATOR', '.'); bWriteStringReg('', csBDEDirFormat + '\NUMBER', 'DECIMALDIGITS', '2'); bWriteStringReg('', csBDEDirFormat + '\NUMBER', 'LEADINGZERON', 'TRUE');   bWriteStringReg('', csBDEDirDriver + '\INIT', csNetDir, sDir); bWriteStringReg('', csBDEDirDriver + '\INIT', 'VERSION', '3.0'); bWriteStringReg('', csBDEDirDriver + '\INIT', 'TYPE', 'FILE'); bWriteStringReg('', csBDEDirDriver + '\INIT', 'LANGDRIVER', 'intl');   bWriteStringReg('', csBDEDirDriver + '\TABLE CREATE', 'LEVEL', '4'); bWriteStringReg('', csBDEDirDriver + '\TABLE CREATE', 'BLOCK SIZE', '4096'); bWriteStringReg('', csBDEDirDriver + '\TABLE CREATE', 'FILL FACTOR', '95'); bWriteStringReg('', csBDEDirDriver + '\TABLE CREATE', 'STRICTINTEGRTY', 'TRUE'); Result := true; EXCEPT Result := false; END; end;   // Install BDE Default // disk: // \ // | // Dir x // | // |- Rep EXE // |- Rep BDE function VerifBDE(const sDirExe, sAlias: string): boolean; var i: integer; sDirBde: string; Opendialog: TOpenDialog; begin Result := false; if not BDEExist then begin if Length(sDirExe) > 3 then begin for i := Length(sDirEXE) - 1 downto 1 do begin if Copy(sDirEXE, i, 1) <> '\' then Continue; sDirBde := Copy(sDirEXE, 1, i); // rep -1 Break; end; end else sDirBde := sDirExe; sDirBde := sDirBde + 'DBD\'; TRY ChDir(sDirBde); EXCEPT on E:EInOutError do begin ShowMessage('STOP: Moteur de bases de données non trouvé. Définir le chemin...'); OpenDialog := TOpenDialog.Create(nil); with OpenDialog do begin InitialDir := sDirExe; Filter := ' Fichiers config BDE|' + csCfg; Title := 'Sélectionner le Fichier Config du BDE: ' + csCfg; if OpenDialog.Execute then begin sDirBde := FileName; OpenDialog.Free; // Extrait Dir BDE i := PosEx('\', sDirBde, Length(sDirBde) - Length(csCfg) - 1); if i > 3 then sDirBde := Copy(sDirBde, 1, i); // rep BDE end else begin OpenDialog.Free; Exit; end; end; // with end; // on END; TRY ChDir(sDirBde); EXCEPT on E:EInOutError do Exit; END; if IOResult = 0 then // Dir existe sDirBde := GetCurrentDir; if not FileExists(sDirBde + '\' + csCfg) then begin // a priori BDE inexistant ShowMessage('STOP: Moteur de bases de données non trouvé. L''application ne peut continuer...'); Exit; end; // BDE trouvé, màj Base de Registre if BDE_Init(sDirBde) then // init Dir BDE ShowMessage('Moteur de Base de Données inialisé ...'); ChDir(sDirEXE); // restore Dir demarrage EXE end; // if Result := true; end; // Test BDE Registry function BDE_Exist: boolean; var Reg: TRegistry; sFileIdapi: string; begin Result := false; Reg := TRegistry.Create; with Reg do begin RootKey := HKEY_LOCAL_MACHINE; OpenKey(csBDEDir, false); TRY sFileIdapi := ReadString('CONFIGFILE01'); // BDE installed if sFileIdapi <> '' then begin if FileExists(sFileIdapi) then Result := true; // force NetDir = Dir du BDE sFileIdapi := ReadString('DLLPATH'); bWriteStringReg('', csBDEDirDriver + '\INIT', csNetDir, sFileIdapi); end; FINALLY CloseKey; END; end; // with end; // Test, clear, delete, create Alias function InitAlias(Session: TSession; csTypeTable: string; Table: TTable; var sBDDir: string): boolean; var sAlias: string; begin Result := false; sAlias := Table.DatabaseName; // Alias with Session do begin if IsAlias(sAlias) then begin // Exist = delete DeleteAlias(sAlias); SaveConfigFile; end; ConfigMode := cmAll; if not IsAlias(sAlias) then begin // création AddStandardAlias(sAlias, sBDDir, csTypeTable); // crée en memoire le nouvel Alias end; SaveConfigFile; end; // with TRY // vérification Table.Open; Table.Close; Result := true; EXCEPT on E:EDBEngineError do if (E.Errors[0].ErrorCode = 11011) then begin ShowMessage('Les bases de données n''existent pas dans <' + sAlias + '>. Application indisponible !'); end; END; end;   function Test_BDE(sDirEXE: string; Table: TTable): boolean; var i: integer; sBDDir: string; Opendialog: TOpenDialog; begin Result := false; TRY Table.Open; EXCEPT // vérif si BDE installé if not VerifBDE(sDirExe, Table.DataBaseName) then begin ShowMessage('Moteur Base de donnée non trouvé ... cela ne sert à rien de continuer !'); Exit; end; END; sBDDir := sDirExe; if not FileExists(sDirExe + Table.TableName) then begin OpenDialog := TOpenDialog.Create(nil); with OpenDialog do begin InitialDir := sDirExe; Filter := ' Fichiers Base de donnée|' + Table.TableName; Title := 'Sélectionner la Base de donnée: ' + Table.TableName; if OpenDialog.Execute then begin sBDDir := FileName; OpenDialog.Free; i := PosEx('\', sBDDir, Length(sBDDir) - Length(Table.TableName) - 1); if i > 3 then sBDDir := Copy(sBDDir, 1, i); // rep BDE end else begin OpenDialog.Free; ShowMessage('BD inaccessible. Terminé'); Exit; end; end; // with end; ChDir(sBDDir); sBDDir := GetCurrentDir; // format standard if not InitAlias(Session, 'PARADOX', Table, sBDDir) then begin ShowMessage('Impossible de trouver les Bases de données ... cela ne sert à rien de continuer !'); Exit; end; // if Result := true; end;     end.

---

Bonjour,

Je penchai plus vers une utilisation de TFile pour lire les données d'un fichier binaire, j'ai cru comprendre que le fichier idapi32.cfg contenait en fait une arborescence.

Pour répondre à ton code
Ce n'est pas ce qui est contenu dans les registres que je veut changer mais l'emplacement d'une base de données d'un alias.
En D3 je le faisais déjà

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65

Recherche ALIAS @Param Alias nom de l alias BDE @Param Dans Chemin résultant ----------------------------------------------------------} procedure TForm1.Dir(Alias : String;Dans : TLabel); var AParams : TStringList; begin if not Session.isAlias(Alias) then begin ShowMessage(Alias+' Inexistant'); Dans.Caption:=''; end else begin AParams:=TStringList.Create; try Session.GetAliasParams(Alias,AParams); Dans.Caption:=Copy(AParams.Strings[0],13,255); finally AParams.Free; end; end; end;   ///BASCULE VERS SERVEUR procedure TForm1.LocalBtnClick(Sender: TObject); var AParams : TStringList; lzParam : String; begin AParams:=TStringList.Create; try AParams.Add('SERVER NAME='+LDirBase.Caption); Session.ModifyAlias('Base',AParams); AParams.Clear; Session.SaveConfigFile; // Demarre serveur local // lzParam:='START InterbaseGuardian'; // ShellExecute(Handle,'OPEN','NET',PChar(lzParam),nil,SW_HIDE); finally Aparams.Free; end; Close; end;   ///BASCULE VERS LOCAL procedure TForm1.ServeurBtnClick(Sender: TObject); var AParams : TStringList; lzParam : String; begin AParams:=TStringList.Create; try AParams.Add('SERVER NAME='+MDirBase.Caption); Session.ModifyAlias('Base',AParams); AParams.Clear; Session.SaveConfigFile; //arret serveur local // lzParam:='STOP InterbaseGuardian'; // ShellExecute(Handle,'OPEN','NET',PChar(lzParam),nil,SW_HIDE); // lzParam:='STOP InterbaseServer'; // ShellExecute(Handle,'OPEN','NET',PChar(lzParam),nil,SW_HIDE); finally Aparams.Free; end; Close; end;

---

L'inconvénient de cette méthode était l'obligation d'avoir 3 alias : Base, Local Base, Serveur Base
bon, il est vrai que j'aurais pu utiliser un fichier ini ou autre pour garder les chemins Local Base et Serveur Base
je me demandai simplement s'il n'y avait pas moyent d'attaquer directement le fichier cfg sans passer par session

La sauvegarde et lecture des Alias passe par TSession
voici quelques archives

Pièce jointe 442227

+ ces infos

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Function GetAliasPath(Const Alias:String):String; Var AliasList:TStringList; i:Longint; DBPath:String; Begin Result:=''; AliasList:=TStringList.Create; try Session.GetAliasNames(AliasList); i:=AliasList.IndexOf(Alias); if i<0 then raise EDatabaseError.Create('Alias '+Alias+' inexistant') else Begin Session.GetAliasParams(Alias,AliasList); DBPath := AliasList.Values['PATH']; if DBPath='' then raise EDatabaseError.Create('Alias path from '+Alias+' invalid') else Result:=IncludeTrailingBackslash(DBPath); end; finally AliasList.Free; end; End;

---

pour la sauvegarde SaveConfigFile

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

function InitAlias(Session: TSession; csTypeTable: string; Table: TTable; var sBDDir: string): boolean; var sAlias: string; begin Result := false; sAlias := Table.DatabaseName; // Alias with Session do begin if IsAlias(sAlias) then begin // Exist = delete DeleteAlias(sAlias); SaveConfigFile; end; ConfigMode := cmAll; if not IsAlias(sAlias) then begin // création AddStandardAlias(sAlias, sBDDir, csTypeTable); // crée en memoire le nouvel Alias end; SaveConfigFile; end; // with TRY // vérification Table.Open; Table.Close; Result := true; EXCEPT on E:EDBEngineError do if (E.Errors[0].ErrorCode = 11011) then begin ShowMessage('Les bases de données n''existent pas dans <' + sAlias + '>. Application indisponible !'); end; END; end;

---

Alain,

Changer un alias via un TSession, ça je sais faire et même ensuite sauvegarder les modifications

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

// Rio var Response : IHttpResponse; IP : String; RegEx : TREgEx; IniFile : TInifile; IniFileName : String; AParams : TStringList; begin   Response:=NetHttpClient1.Get('http://checkip.dyndns.org/'); RegEx:=TRegEx.Create('(?<IPV4>\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})'); if RegEx.Match(Response.ContentAsString).Success then IP:=RegEx.Match(Response.ContentAsString).Value; Caption:=Format('Adresse Internet %s',[IP]); IniFileName:=TPath.Combine(TPath.GetHomePath,'Gpao'); Forcedirectories(IniFileName); IniFileName:=TPath.Combine(TPath.GetHomePath,'Settings.ini'); IniFile:=TIniFile.Create(IniFileName); with IniFile do begin IPLocale:=ReadString('Adresse','FAI','xxx.xxx.xxx.xxx'); IPFirebird:=ReadString('Adresse','Serveur','192.168.1.46'); end; // Changer l'alias selon localisation AParams:=TStringList.Create; try Session1.GetAliasParams('base',AParams); if IP=IPLocale then AParams.Values['SERVER NAME']:=IPFirebird+':base' // il me reste le cas peu probable où le programme s'exécute sur le serveur => 'base' else AParams.Values['SERVER NAME']:=IPLocale+':base'; Session1.ModifyAlias('Base',AParams); Session1.SaveConfigFile; finally AParams.Free; end;

---

je pensais qu'il était possible d'éditer directement IDAPI32.CFG et c'est cette question que je posais, cela m'aurait évité l'installation des composants BDE :roll:

Le BDE est protégé par brevet c'est pour cela qu'il faut passer par leur unité et c'est pour celà qu'a priori il n'existe pas d'autres solutions

Bon, pas de bol j'en resterai donc à l'utilisation d'un TSession :roll: