unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, ComObj, ComConst, registry, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure tlibcallback(guid:TGuid; const version, tlibname, filename: string; lcid:DWORD);
end;
type
TEnumTypeLibrariesCallback = procedure(guid:TGuid; const version, tlibname, filename:string; Lcid:DWORD) of object;
procedure EnumTypeLibraries(callback:TEnumTypeLibrariesCallback; const UNCName:string='');
var
Form1: TForm1;
implementation
{$R *.dfm}
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;
procedure TForm1.tlibcallback(guid:TGuid; const version, tlibname, filename: string; lcid:DWORD);
begin
Memo1.Lines.Add(GUIDToString(guid)+' ('+version+') : '+tlibname+ ' :'+filename);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
EnumTypeLibraries(tlibcallback);
end;
end. |
|
