Получить список зарегистрированных Win32 модулей и их версий



Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ The registered Win32 type libraries/modules are registered with a
version number in the registry.
But it's possible that one modlue has more than one version.
The recursive function "RecurseWin32" searches from a certain path
for all occurences of the searched key.
For instance, I get the following entries for
"Visual Basic For Applications" on my system:
000204F3-0000-0000-C000-000000000046   \ 1.0 \  7  \ win32
"c:\\WINDOWS\\SYSTEM\\vbade32.olb"
000204F3-0000-0000-C000-000000000046   \ 1.0 \  9  \ win32
"c:\\WINDOWS\\SYSTEM\\VBAEN32.OLB"
}
{ Die installierten bzw. registrierten Win32 TypeLibs bzw. "Modulen"
mussen sich mit einer Versionsnummer in der registry eintragen.
Zu einem bestimmten "Modul" konnen aber mehrere Versionen in der
Registry eingetragen sein.
Welche?
Kernstuck ist die rekursive Function "RecurseWin32", die ab einem
bestimmten Pfad nach jedem Vorkommen des gesuchten Schlussels sucht...
Zum Beispiel ermmittelt es auf meinem System entsprechend folgendes zum
Eintrag "Visual Basic For Applications"
000204F3-0000-0000-C000-000000000046   \ 1.0 \  7  \ win32
"c:\\WINDOWS\\SYSTEM\\vbade32.olb"
000204F3-0000-0000-C000-000000000046   \ 1.0 \  9  \ win32
"c:\\WINDOWS\\SYSTEM\\VBAEN32.OLB"
Diese Technik la?t sich ubrigens an weiteren Bedurfnisse anpassen...
}
{It's a recursiv one :-}
function RecurseWin32(const R: TRegistry; const ThePath: string;
const TheKey: string): string;
var
TheList: TStringList;
i: Integer;
LP: string;
OnceUponATime: string;
begin
Result  := '-';
TheList := TStringList.Create;
try
R.OpenKey(ThePath, False);
R.GetKeyNames(TheList);
R.CloseKey;
if TheList.Count = 0 then Exit;
for i := 0 to TheList.Count - 1 do with TheList do
begin
LP := ThePath + '\' + TheList[i];
if CompareText(Strings[i], TheKey) = 0 then
begin
Result := LP;
Break;
end;
OnceUponATime := RecurseWin32(R, LP, TheKey);
if OnceUponATime <> '-' then
begin
Result := OnceUponATime;
Break;
end;
end;
finally
TheList.Clear;
TheList.Free;
end;
end;
{ Create the output list: you may change the format as you need ...}
function GetWin32TypeLibList(var Lines: TStringList): Boolean;
var
R: TRegistry;
W32: string;
i, j, TheIntValue, TheSizeOfTheIntValue: Integer;
TheSearchedValue, TheSearchedValueString: string;
TheVersionList, TheKeyList: TStringList;
TheBasisKey: string;
begin
Result := True;
try
try
R          := TRegistry.Create;
TheVersionList := TStringList.Create;
TheKeyList := TStringList.Create;
R.RootKey := HKEY_CLASSES_ROOT;
R.OpenKey('TypeLib', False);
TheBasisKey := R.CurrentPath;
(* Basis Informations *)
case R.GetDataType('') of
rdUnknown: ShowMessage('Nothing ???');
rdExpandString, rdString: TheSearchedValueString := R.ReadString('');
rdInteger: TheIntValue         := R.ReadInteger('');
rdBinary: TheSizeOfTheIntValue := R.GetDataSize('');
end;
(* Build the List of Keys *)
R.GetKeyNames(TheKeyList);
R.CloseKey;
ShowMessage(TheKeyList.Strings[1]);
for i := 0 to TheKeyList.Count - 1 do
(* Loop around the typelib entries)
(* Schleife um die TypeLib Eintrage *)
with TheKeyList do
if Length(Strings[i]) > 0 then
begin
R.OpenKey(TheBasisKey + '\' + Strings[i], False);
TheVersionList.Clear;
R.GetKeyNames(TheVersionList);
R.CloseKey;
(* Find "Win32" for each version *)
(* Finde der "win32" fur jede VersionVersion:*)
for j := 0 to TheVersionList.Count - 1 do
if Length(TheVersionList.Strings[j]) > 0 then
begin
W32 := RecurseWin32(R, TheBasisKey + '\' +
Strings[i] + '\' +
TheVersionList.Strings[j],
'Win32');
if W32 <> '-' then
begin
Lines.Add(W32);
R.OpenKey(W32, False);
case R.GetDataType('') of
rdExpandString,
rdString: TheSearchedValue := R.ReadString('');
else
TheSearchedValue := 'Nothing !!!';
end;
R.CloseKey;
Lines.Add('-----> ' + TheSearchedValue);
end;
end;
end;
finally
TheVersionList.Free;
TheKeyList.Free;
end;
except
Result := False;
end;
end;
{ Example of use / Anwendungsbeispiel }
procedure TForm1.Button1Click(Sender: TObject);
var
L: TStringList;
begin
L := TStringList.Create;
GetWin32TypeLibList(L);
Memo1.Lines.Assign(L);
L.Free;
end;

Далее: Текущий модуль и проект »»