interface
uses Classes, Windows;
type
TEnumTypeLibrariesCallback =
procedure(
guid:TGuid;
const version, tlibname, filename:
string; Lcid:DWORD)
of object;
procedure EnumTypeLibraries(callback:TEnumTypeLibrariesCallback;
const UNCName:string='
');
implementation
uses ActiveX, ComObj, SysUtils, ComConst, registry;
procedure EnumTypeLibraries2(callback:TEnumTypeLibrariesCallback; R:TRegistry);
var
VersionList, KeyList, LcIdList: TStringList;
i, j, k, code : Integer;
lcid : DWORD;
key, tlibname, filename :
string;
guid : TGUID;
begin
KeyList := TStringList.Create;
VersionList := TStringList.Create;
LcIdList := TStringList.Create;
try
R.OpenKey('
TypeLib', False);
R.GetKeyNames(KeyList);
R.CloseKey;
for i := 0
to KeyList.Count-1
do
begin
guid := StringToGUID(KeyList[i]);
key := '
TypeLib\'+KeyList[i];
R.OpenKeyReadOnly(key);
VersionList.Clear;
R.GetKeyNames(VersionList);
R.CloseKey;
for j := 0
to VersionList.Count-1
do
begin
R.OpenKeyReadOnly(key+'
\'+ VersionList[j]);
tlibname := R.ReadString('
');
R.GetKeyNames(LcIdList);
R.CloseKey;
for k := 0
to LcIdList.Count-1
do
begin
Val(LcIdList[k], lcid, code);
if code = 0
then
begin
R.OpenKeyReadOnly(key+'
\'+ VersionList[j]+'
\'+LcIdList[k]+'
\Win32');
filename := R.ReadString('
');
R.CloseKey;
callback(
guid, VersionList[j], tlibname, filename, lcid);
end;
end;
end;
end;
finally
LcIdList.Free;
VersionList.Free;
KeyList.Free;
end;
end;
procedure EnumTypeLibraries(callback:TEnumTypeLibrariesCallback;
const UNCName:
string);
var
R: TRegistry;
begin
R := TRegistry.Create(KEY_READ);
try
R.RootKey := HKEY_CLASSES_ROOT;
if UNCName <> '
'
then
if not R.RegistryConnect(UNCName)
then
raise Exception.CreateFmt('
Can''
t connect to registry of %s', [UNCName]);
EnumTypeLibraries2(callback, R);
finally
R.Free;
end;
end;