BDE, savoir si des programmes sont connectés

**SergioMaster** · 29/01/2020, 12h08

Bonjour,

Cela fait longtemps que je n'avais pas touché à BDE mais, vieux programmes non migrés obligent je dois faire un petit programme qui change les alias selon la localisation du poste.
(pour info cela à un rapport avec ce sujet résolu)
En fait mon programme permet de changer SERVER NAME

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TMain.ChangerAlias(const alias, ip: String);
var SL : TStringList;
begin
SL:=TStringList.Create;
try
  Session.GetAliasParams(alias,SL);
  SL.Values['SERVER NAME']:=format('%s:%s',[Ip,alias]);
  Session.ModifyAlias(Database1.AliasName,SL);
  Session.SaveConfigFile;
finally
  SL.Free;
end;
end;

Quand on change les alias via BDEAdmin, si un programme a ouvert une session, il y a message d'avertissement comme quoi des sessions sont ouvertes et qu'il vaudrait mieux les fermer avant de faire des modifications (ou du moins un blabla du genre).
Voilà ce que je voudrais pouvoir détecter via programme, est-ce possible ?
Si non, est-ce que le changement de serveur dans l'alias va avoir des répercussions sur les programmes ouverts (AMHA non mais ...) ?

**ShaiLeTroll** · 29/01/2020, 14h38

L'unité BDE contient plus d'API dbi* ... genre DbiGetSysInfo, on y trouve iSessions "Number of sessions (For all clients)"
Voir si il y a d'autres fonction pour une granularité à l'Alias

**SergioMaster** · 29/01/2020, 16h58

J'y croyais mais a priori non, alors que j'ai un programme qui "tourne" avec le même alias iSessions est à 0 avec le programme de changement d'alias

Cela écrit j'ai comme un problème avec BDE, après moults essais je crois bien que je l'ai planté

~~Symptômes : BDEAdmin ne s'exécute plus, Session.SaveConfigFile plante le programme, etc.~~
Chose à savoir pour que Session.SaveConfigFile ne plante pas le programme, il faut que l'option de sauvegarde de la configuration (Object/Options) de BDE soit windows 3.1 and Windows 95/NT (ça rajeuni pas !)

**oneDev** · 29/01/2020, 17h32

Il manque un % non ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

format('%s:s',[Ip,alias])

**SergioMaster** · 29/01/2020, 17h44

@Onedev : Oui, petit problème de saisie, le code fourni étant un résumé (j'ai corrigé)
@Alweber : Test fait avec W10, mais je dois tester sur des Vista et plus.
Pour ce qui est des registres, je préfère donc éviter d'où le changement d'options du BDE.

Reste donc ma question du début. La solution que j'envisage tester si je peux ouvrir l'alias (ce n'est pas du paradox mais INTRBASE) en mode exclusif, j'ai entre-aperçu ça dans les options.
Je vais quand même refaire un test de DbiGetSysInfo

**SergioMaster** · 30/01/2020, 10h35

Bonjour,

Envoyé par SergioMaster

La solution que j'envisage tester si je peux ouvrir l'alias (ce n'est pas du paradox mais INTRBASE) en mode exclusif, j'ai entre-aperçu ça dans les options.

Mauvaise idée, uniquement valable en mon-utilisateur

Je vais quand même refaire un test de DbiGetSysInfo

Toujours 0 donc inutilisable.

Pendant qu'on y est, vous savez si BDE supporte l'IPV6 pour la connexion ? Jusqu'à présent je n'ai eu à faire qu'avec de l'IPV4 ou un nom de domaine

**ALWEBER** · 29/01/2020, 16h50

Juste pour info quelques archives

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**ALWEBER** · 29/01/2020, 17h31

Quelle version de Windows ?

**ALWEBER** · 30/01/2020, 11h07

Le BDE est un système de partage de fichiers en collaboratif donc indépendant des protocoles réseau.
Le seul problème que j'ai eu il y a quelques années : mon client avait une antenne à l'étranger qui utilisait un serveur Linux en tant que serveur de fichiers.
Le serveur Linux différencie Minuscules et Majuscules donc on avait plusieurs instances d'un même fichier (ex. MATABLE.DB et Matable.DB) ce qui perturbait les fonctionnement du BDE (fichiers LCK et NET)

**SergioMaster** · 31/01/2020, 10h43

Je viens de résoudre (façon de parler) mon problème en trichant.
Je n'ai trouvé aucun moyen pour détecter si des programmes utilisait déjà le BDE mais, sachant que c'est pour se connecter à une base Firebird, j'ai utilisé une requête sur une table de monitoring

Code SQL :

Sélectionner tout - Visualiser dans une fenêtre à part

SELECT  COUNT(*) C FROM MON$ATTACHMENTS WHERE MON$REMOTE_ADDRESS=:IP

Ainsi, si la colonne C à une valeur supérieure à 1 je sais qu'alors il y a d'autres programmes utilisant la base de données qui s'exécute sur le poste (paramètre IP).
Cela dit, cela ne veut pas dire qu'il s'agisse de programme utilisant BDE (programmes qui vont disparaitre à moyen terme, il serait temps

) mais cela me permet de clore le sujet

**Zatoobux** · 19/02/2020, 10h30

Bonjour,

J'arrive un peu tard... mais peut être que cette solution peut intéresser :
Je regardais les processus qui avaient chargés isapi32.dll.
L'avantage est de pouvoir indiquer à l'utilisateur les applications qui utilisent le bde au moment du test.

**SergioMaster** · 19/02/2020, 11h02

Il n'est jamais trop tard, mais je n'arrive pas à saisir

Je regardais les processus qui avaient chargés isapi32.dll.

Est-ce que seul BDE utilise cette DLL ? C'est mon doute.
Et comment récupérer ça dans un programme ? Aujourd'hui j'avoue n'avoir aucune idée de code WMI pour la liste des process OK mais pour savoir ceux qui ont chargé ISAPI32 ?

**Zatoobux** · 19/02/2020, 11h57

Oui Idapi32.dll est une dll installée par et pour le BDE.

Ci dessous le code (D2006) en enlevant ce qui est trop spécifique à mes projets et sans prendre le temps de le tester (en plus faudrait que je trouve un truc utilisant le BDE !)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
...
type
  TbsEPInit_ReturnFunc = procedure (aActionName: string; const StepCount: integer) of object;
  TbsEPStep_ReturnFunc = procedure (aItemName: String; aStepIt: boolean; var aCancel: boolean) of object;
 
...
 
function BDEIsUsed(var aBDEUseMessage: String): boolean;
function GetDLLLoaded(aDLLToCheck: array of String; aUsedByProcess, aExeDisplayName: TStrings; aInitReturn: TbsEPInit_ReturnFunc; aStepReturn: TbsEPStep_ReturnFunc): boolean;
 
implementation
 
/// tester si BDE utilise
function BDEIsUsed(var aBDEUseMessage: String): boolean;
var
  aUsedByProcess, aExeDisplayName: TStringList;
  i: integer;
begin
  result := false;
 
  aExeDisplayName := TStringList.Create;
  aUsedByProcess := TStringList.Create;
  try
    aBDEUseMessage := '';
    aExeDisplayName.Values['bdeadmin.exe'] := _('Administrateur BDE');
    aExeDisplayName.Values['pdxwin32.exe'] := 'Corel Paradox';
 
    if GetDLLLoaded(['IDAPI32.DLL'], aUsedByProcess, aExeDisplayName, nil, nil) then
      begin
        result := true;
 
        aBDEUseMessage := 'Programmes qui utilisent le BDE : ';
        for i := 0 to pred(aUsedByProcess.Count) do
          begin
            if i > 0 then aBDEUseMessage := aBDEUseMessage + ', ';
            aBDEUseMessage := aBDEUseMessage +  aUsedByProcess[i];
          end;
      end;
  finally
    aUsedByProcess.Free;
    aExeDisplayName.Free;
  end;
end;
 
 
{*
Indique si une ou plusieurs DLL sont chargés dans le systemes.
@param aDLLToCheck Liste des nom de DLL à tester
@param aUsedByProcess Liste des noms de processus qui utilsent les DLL (optionel)
@param aExeDisplayName Nom a afficher pour les exe. Structure de fichier ini(optionel)
@return renvoie vrai si au moins un processus utilise une DLL de aDLLToCheck
}
function GetDLLLoaded(aDLLToCheck: array of String; aUsedByProcess, aExeDisplayName: TStrings; aInitReturn: TbsEPInit_ReturnFunc; aStepReturn: TbsEPStep_ReturnFunc): boolean;
var
  ovi: TOSVersionInfo;
  aDLLToCheckList: TStringList;
  i: integer;
begin
  result := false;
 
  if length(aDLLToCheck) = 0 then Exit;
 
  ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(ovi);
  case ovi.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS: raise Exception.Create('Impossible de lister les DLL chargées par le système.');
    VER_PLATFORM_WIN32_NT:
      begin
        aDLLToCheckList := TStringList.Create;
        try
          for i := 0 to pred(length(aDLLToCheck)) do
            aDLLToCheckList.Add(aDLLToCheck[i]);
          result := GetDLLLoaded_NT(aDLLToCheckList, aUsedByProcess, aExeDisplayName, aInitReturn, aStepReturn);
        finally
          aDLLToCheckList.Free;
        end;
      end;
  end
end;
 
 
function GetDLLLoaded_NT(aDLLToCheck, aUsedByProcess, aExeDisplayName: TStrings; aInitReturn: TbsEPInit_ReturnFunc;
  aStepReturn: TbsEPStep_ReturnFunc): boolean;
var
  hProcess: THandle;
  aCurrPID: DWORD;
  PIDArray: array [0..1023] of DWORD;
  cb: DWORD;
  I: integer;
  j, aModuleCt, aEnumCt: cardinal;
  ProcCount: Integer;
  aProcessStrName, aModuleStrName: String;
  aModuleName, aProcessName: array[0..MAX_PATH] of char;
  aModuleArray: array of HMODULE;
  aThisProcessUseDLL, aCancel: boolean;
  aTitle: String;
begin
  result := false;
  if aDLLToCheck = nil then exit;
  if aDLLToCheck.Count = 0 then exit;
 
  aCurrPID := GetCurrentProcessId;
 
  EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
  ProcCount := cb div SizeOf(DWORD);
 
  if assigned(aInitReturn) then
    aInitReturn('GetLoadedDLL', ProcCount);
 
  for i := 0 to pred(ProcCount) do
    begin
      if assigned(aStepReturn) then
        aStepReturn(inttostr(PIDArray[I]), false, aCancel);
 
      if aCancel then exit;
 
      if PIDArray[I] <> aCurrPID then
        begin
          hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PIDArray[I]);
          if (hProcess <> 0) then
            try
              GetModuleFilenameExA(hProcess, 0, aProcessName, SizeOf(aProcessName));
              aProcessStrName := aProcessName;
 
              if EnumProcessModules(hProcess, Nil, 0, aEnumCt) then
                begin
                  aModuleCt := aEnumCt div SizeOf(DWORD);
                  SetLength(aModuleArray, aModuleCt);
                  EnumProcessModules(hProcess, @aModuleArray[0], aEnumCt, aEnumCt);
 
                  aThisProcessUseDLL := false;
                  j := 0;
                  while (j < aModuleCt) and (not aThisProcessUseDLL) do
                    begin
                      GetModuleFileNameExA(hProcess, aModuleArray[j], aModuleName, SizeOf(aModuleName));
                      aModuleStrName := aModuleName;
                      aModuleStrName := ExtractFileName(aModuleStrName);
 
                      if aDLLToCheck.IndexOf(aModuleStrName) <> -1 then
                        begin
                          aThisProcessUseDLL := true;
                          if assigned(aUsedByProcess) then
                            begin
                              aTitle := '';
 
                              if assigned(aExeDisplayName) then
                                aTitle := aExeDisplayName.Values[lowercase(extractFileName(aProcessStrName))];
 
                              if aTitle = '' then
                                aUsedByProcess.Add(extractFileName(aProcessStrName))
                              else
                                aUsedByProcess.Add(Format('%s (%s)', [aTitle, extractFileName(aProcessStrName)]));
 
                            end;
                        end;
                      inc(j);
                    end;
 
                  if aThisProcessUseDLL then
                    result := true;
                  Finalize(aModuleArray);
                end;
            finally
              CloseHandle(hProcess);
            end;
        end;
      if assigned(aStepReturn) then
        aStepReturn(inttostr(PIDArray[I]), true, aCancel);
 
      if aCancel then exit;
    end;
end;

BDE, savoir si des programmes sont connectés

Bases de données Delphi

Vue hybride

Discussions similaires

Partager

Partager