mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-19 11:39:23 +02:00
LazActiveX: Display and search registered controls and libraries. Issue #25908, patch from David Zimmer.
git-svn-id: trunk@44515 -
This commit is contained in:
juha
parent
5df636d70f
commit
519d7fa8c0
@ -6,8 +6,7 @@ interface
|
||||
|
||||
resourcestring
|
||||
axImportTypeLibrary = 'Import Type Library';
|
||||
axSelectDirectoryToStorePackagePLpk = 'Select directory to store package %sP'
|
||||
+'.lpk';
|
||||
axSelectDirectoryToStorePackagePLpk = 'Select directory to store package %sP.lpk';
|
||||
axFileContainingTypeLibrary = 'File containing type library:';
|
||||
axCreateVisualComponentTActiveXContainerDescendant = 'Create visual '
|
||||
+'component (TActiveXContainer descendant)';
|
||||
|
||||
@ -1,88 +1,88 @@
|
||||
object FrmTL: TFrmTL
|
||||
Left = 251
|
||||
Height = 153
|
||||
Top = 189
|
||||
Width = 341
|
||||
AutoSize = True
|
||||
Left = 580
|
||||
Height = 509
|
||||
Top = 139
|
||||
Width = 484
|
||||
Anchors = []
|
||||
BorderIcons = [biSystemMenu]
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Import Type Library'
|
||||
ClientHeight = 153
|
||||
ClientWidth = 341
|
||||
ClientHeight = 509
|
||||
ClientWidth = 484
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.3'
|
||||
object FNETL: TFileNameEdit
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideTop.Control = Label1
|
||||
AnchorSideLeft.Control = CBxTLActiveX
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 21
|
||||
Top = 19
|
||||
Width = 294
|
||||
AnchorSideBottom.Control = CBxTLActiveX
|
||||
Left = 10
|
||||
Height = 28
|
||||
Top = 350
|
||||
Width = 443
|
||||
DialogOptions = []
|
||||
Filter = 'Type library files (*.tlb;*.dll;*.exe;*.ocx;*.olb)|*.tlb;*.dll;*.exe;*.ocx;*.olb|All Files (*.*)|*.*'
|
||||
FilterIndex = 0
|
||||
HideDirectories = False
|
||||
ButtonWidth = 23
|
||||
NumGlyphs = 1
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Bottom = 3
|
||||
MaxLength = 0
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 6
|
||||
Height = 13
|
||||
Top = 6
|
||||
Width = 130
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
AnchorSideLeft.Control = FNETL
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideBottom.Control = FNETL
|
||||
Left = 10
|
||||
Height = 20
|
||||
Top = 329
|
||||
Width = 179
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Bottom = 1
|
||||
Caption = 'File containing type library:'
|
||||
ParentColor = False
|
||||
end
|
||||
object CBxTLActiveX: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = FNETL
|
||||
AnchorSideLeft.Control = CBxTLPackage
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 17
|
||||
AnchorSideBottom.Control = CBxTLPackage
|
||||
Left = 10
|
||||
Height = 24
|
||||
Hint = 'CBxTLActiveX'
|
||||
Top = 46
|
||||
Width = 296
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
BorderSpacing.Right = 6
|
||||
Top = 381
|
||||
Width = 404
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Bottom = 3
|
||||
Caption = 'Create visual component (TActiveXContainer descendant)'
|
||||
OnChange = CBxTLActiveXChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object CBxTLPackage: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = CBxTLActiveX
|
||||
AnchorSideLeft.Control = CBxTLRecurse
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 17
|
||||
Top = 69
|
||||
Width = 94
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
BorderSpacing.Right = 6
|
||||
AnchorSideBottom.Control = CBxTLRecurse
|
||||
Left = 10
|
||||
Height = 24
|
||||
Top = 408
|
||||
Width = 127
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Bottom = 3
|
||||
Caption = 'Create package'
|
||||
OnChange = CBxTLPackageChange
|
||||
TabOrder = 2
|
||||
end
|
||||
object CBxTLRecurse: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = CBxTLPackage
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 17
|
||||
Top = 92
|
||||
Width = 152
|
||||
AnchorSideBottom.Control = ButtonPanel
|
||||
Left = 10
|
||||
Height = 24
|
||||
Top = 435
|
||||
Width = 207
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 6
|
||||
Caption = 'Convert dependant typelibs'
|
||||
@ -93,10 +93,10 @@ object FrmTL: TFrmTL
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 32
|
||||
Top = 115
|
||||
Width = 329
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
Height = 38
|
||||
Top = 465
|
||||
Width = 472
|
||||
Anchors = []
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
@ -108,7 +108,93 @@ object FrmTL: TFrmTL
|
||||
TabOrder = 4
|
||||
ShowButtons = [pbOK, pbCancel]
|
||||
end
|
||||
object PageControl1: TPageControl
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideBottom.Control = Label1
|
||||
Left = 10
|
||||
Height = 318
|
||||
Top = 5
|
||||
Width = 464
|
||||
ActivePage = TabSheet1
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Bottom = 6
|
||||
TabIndex = 0
|
||||
TabOrder = 5
|
||||
TabPosition = tpBottom
|
||||
OnChange = PageControl1Change
|
||||
object TabSheet1: TTabSheet
|
||||
Caption = 'Visual Controls'
|
||||
ClientHeight = 285
|
||||
ClientWidth = 456
|
||||
object lstControls: TListBox
|
||||
Left = 17
|
||||
Height = 209
|
||||
Top = 14
|
||||
Width = 374
|
||||
ItemHeight = 0
|
||||
OnClick = lstControlsClick
|
||||
Sorted = True
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object TabSheet2: TTabSheet
|
||||
Caption = 'ActiveX References'
|
||||
ClientHeight = 281
|
||||
ClientWidth = 442
|
||||
object lstRefs: TListBox
|
||||
Left = 20
|
||||
Height = 201
|
||||
Top = 13
|
||||
Width = 376
|
||||
ItemHeight = 0
|
||||
OnClick = lstRefsClick
|
||||
Sorted = True
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
object lstFiltered: TListBox
|
||||
Left = 70
|
||||
Height = 90
|
||||
Top = 48
|
||||
Width = 120
|
||||
ItemHeight = 0
|
||||
OnClick = lstFilteredClick
|
||||
Sorted = True
|
||||
TabOrder = 6
|
||||
Visible = False
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 30
|
||||
Height = 48
|
||||
Top = 232
|
||||
Width = 375
|
||||
ClientHeight = 26
|
||||
ClientWidth = 371
|
||||
TabOrder = 7
|
||||
object Label2: TLabel
|
||||
Left = 7
|
||||
Height = 20
|
||||
Top = 2
|
||||
Width = 44
|
||||
Caption = 'Search'
|
||||
ParentColor = False
|
||||
end
|
||||
object txtSearch: TEdit
|
||||
AnchorSideLeft.Control = Label2
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
Left = 57
|
||||
Height = 28
|
||||
Top = -4
|
||||
Width = 315
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
OnChange = txtSearchChange
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object SelectDirectoryDialog1: TSelectDirectoryDialog
|
||||
left = 240
|
||||
left = 344
|
||||
top = 416
|
||||
end
|
||||
end
|
||||
|
||||
@ -7,11 +7,22 @@ interface
|
||||
{$ifndef wince}
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
|
||||
StdCtrls, ButtonPanel, lazideintf, projectintf, PackageIntf, activexstrconsts,
|
||||
LazUTF8;
|
||||
StdCtrls, ButtonPanel, ComCtrls, registry, strutils, activexstrconsts, LazUTF8,
|
||||
lazideintf, projectintf, PackageIntf;
|
||||
|
||||
type
|
||||
|
||||
TEntry = class
|
||||
public
|
||||
path: string;
|
||||
progID: string;
|
||||
typeLib: string;
|
||||
version: string;
|
||||
Name: string;
|
||||
clsID: string;
|
||||
isControl: boolean;
|
||||
end;
|
||||
|
||||
{ TFrmTL }
|
||||
|
||||
TFrmTL = class(TForm)
|
||||
@ -20,15 +31,30 @@ type
|
||||
CBxTLPackage: TCheckBox;
|
||||
CBxTLRecurse: TCheckBox;
|
||||
FNETL: TFileNameEdit;
|
||||
GroupBox1: TGroupBox;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
lstControls: TListBox;
|
||||
lstFiltered: TListBox;
|
||||
lstRefs: TListBox;
|
||||
PageControl1: TPageControl;
|
||||
SelectDirectoryDialog1: TSelectDirectoryDialog;
|
||||
TabSheet1: TTabSheet;
|
||||
TabSheet2: TTabSheet;
|
||||
txtSearch: TEdit;
|
||||
procedure CBxTLActiveXChange(Sender: TObject);
|
||||
procedure CBxTLPackageChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure lstControlsClick(Sender: TObject);
|
||||
procedure lstFilteredClick(Sender: TObject);
|
||||
procedure lstRefsClick(Sender: TObject);
|
||||
procedure PageControl1Change(Sender: TObject);
|
||||
procedure txtSearchChange(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
procedure ListClickHandler(lst: TListBox);
|
||||
public
|
||||
{ public declarations }
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
@ -45,111 +71,413 @@ uses typelib;
|
||||
|
||||
procedure ImpTypeLib(Sender: TObject);
|
||||
|
||||
var TLI:TTypeLibImporter;
|
||||
bPackage,bActiveX,bRecurse:boolean;
|
||||
slTypelibs:TStringList; //sys charset
|
||||
i,j:integer;
|
||||
F:text;
|
||||
sDir,sUnitName:string; //utf8
|
||||
var
|
||||
TLI: TTypeLibImporter;
|
||||
bPackage, bActiveX, bRecurse: boolean;
|
||||
slTypelibs: TStringList; //sys charset
|
||||
i, j: integer;
|
||||
F: Text;
|
||||
sDir, sUnitName: string; //utf8
|
||||
begin
|
||||
FrmTL:= TFrmTL.create(nil);
|
||||
FrmTL := TFrmTL.Create(nil);
|
||||
try
|
||||
if (FrmTL.ShowModal=mrOK) and (FrmTL.FNETL.Filename<>'') then
|
||||
if (FrmTL.ShowModal = mrOk) and (FrmTL.FNETL.Filename <> '') then
|
||||
begin
|
||||
slTypelibs:=TStringList.Create;
|
||||
slTypelibs.add(UTF8ToSys(FrmTL.FNETL.Filename));
|
||||
bActiveX:=FrmTL.CBxTLActiveX.Checked;
|
||||
bPackage:=FrmTL.CBxTLPackage.Checked;
|
||||
bRecurse:=FrmTL.CBxTLRecurse.Checked;
|
||||
i:=0;
|
||||
sDir:='';
|
||||
repeat
|
||||
TLI:=TTypeLibImporter.Create(nil);
|
||||
try
|
||||
TLI.InputFileName:=slTypelibs[i];
|
||||
TLI.ActiveX:=bActiveX;
|
||||
TLI.CreatePackage:=bPackage;
|
||||
slTypelibs := TStringList.Create;
|
||||
slTypelibs.add(UTF8ToSys(FrmTL.FNETL.Filename));
|
||||
bActiveX := FrmTL.CBxTLActiveX.Checked;
|
||||
bPackage := FrmTL.CBxTLPackage.Checked;
|
||||
bRecurse := FrmTL.CBxTLRecurse.Checked;
|
||||
i := 0;
|
||||
sDir := '';
|
||||
repeat
|
||||
TLI := TTypeLibImporter.Create(nil);
|
||||
try
|
||||
TLI.Execute;
|
||||
sUnitName:=SysToUTF8(TLI.UnitName);
|
||||
if bPackage then
|
||||
TLI.InputFileName := slTypelibs[i];
|
||||
TLI.ActiveX := bActiveX;
|
||||
TLI.CreatePackage := bPackage;
|
||||
try
|
||||
TLI.Execute;
|
||||
sUnitName := SysToUTF8(TLI.UnitName);
|
||||
if bPackage then
|
||||
begin
|
||||
with FrmTL.SelectDirectoryDialog1 do
|
||||
with FrmTL.SelectDirectoryDialog1 do
|
||||
begin
|
||||
Title:=Format(axSelectDirectoryToStorePackagePLpk, [sUnitName]);
|
||||
Execute;
|
||||
sDir:=Filename;
|
||||
Title := Format(axSelectDirectoryToStorePackagePLpk, [sUnitName]);
|
||||
Execute;
|
||||
sDir := Filename;
|
||||
end;
|
||||
if (sDir<>'') and (sDir[length(sdir)]<>'\') then
|
||||
sDir:=sDir+'\';
|
||||
AssignFile(F,UTF8ToSys(sDir+sUnitName+'P.lpk'));
|
||||
Rewrite(F);
|
||||
Write(F,TLI.PackageSource.Text);
|
||||
CloseFile(F);
|
||||
AssignFile(F,UTF8ToSys(sDir+sUnitName+'Preg.pas'));
|
||||
Rewrite(F);
|
||||
Write(F,TLI.PackageRegUnitSource.Text);
|
||||
CloseFile(F);
|
||||
if PackageEditingInterface.FindPackageWithName(sUnitName+'P')<>nil then
|
||||
|
||||
if (sDir <> '') and (sDir[length(sdir)] <> '\') then
|
||||
sDir := sDir + '\';
|
||||
AssignFile(F, UTF8ToSys(sDir + sUnitName + 'P.lpk'));
|
||||
Rewrite(F);
|
||||
Write(F, TLI.PackageSource.Text);
|
||||
CloseFile(F);
|
||||
AssignFile(F, UTF8ToSys(sDir + sUnitName + 'Preg.pas'));
|
||||
Rewrite(F);
|
||||
Write(F, TLI.PackageRegUnitSource.Text);
|
||||
CloseFile(F);
|
||||
|
||||
if PackageEditingInterface.FindPackageWithName(sUnitName + 'P') <> nil then
|
||||
begin
|
||||
PackageEditingInterface.DoOpenPackageFile(sDir+sUnitName+'P.lpk',[pofRevert],false);
|
||||
PackageEditingInterface.DoOpenPackageWithName(sUnitName+'P',[],false);
|
||||
PackageEditingInterface.DoOpenPackageFile(sDir+sUnitName+'P.lpk', [pofRevert], False);
|
||||
PackageEditingInterface.DoOpenPackageWithName(sUnitName + 'P', [], False);
|
||||
end
|
||||
else
|
||||
PackageEditingInterface.DoOpenPackageFile(sDir+sUnitName+'P.lpk', [pofAddToRecent], False);
|
||||
end;
|
||||
|
||||
if sDir = '' then // no package, open file in editor
|
||||
LazarusIDE.DoNewEditorFile(FileDescriptorUnit, sUnitName + '.pas',
|
||||
TLI.UnitSource.Text, [nfIsPartOfProject, nfOpenInEditor])
|
||||
else
|
||||
PackageEditingInterface.DoOpenPackageFile(sDir+sUnitName+'P.lpk',[pofAddToRecent],false);
|
||||
end;
|
||||
if sDir='' then // no package, open file in editor
|
||||
LazarusIDE.DoNewEditorFile(FileDescriptorUnit,sUnitName+'.pas',
|
||||
TLI.UnitSource.Text,[nfIsPartOfProject,nfOpenInEditor])
|
||||
else
|
||||
begin //save in same dir as package
|
||||
AssignFile(F,UTF8ToSys(sDir+sUnitName+'.pas'));
|
||||
Rewrite(F);
|
||||
Write(F,TLI.UnitSource.Text);
|
||||
CloseFile(F);
|
||||
AssignFile(F, UTF8ToSys(sDir + sUnitName + '.pas'));
|
||||
Rewrite(F);
|
||||
Write(F, TLI.UnitSource.Text);
|
||||
CloseFile(F);
|
||||
end;
|
||||
// don't create package or ActiveX container for dependencies
|
||||
bPackage:=false;
|
||||
bActiveX:=false;
|
||||
for j:=0 to TLI.Dependencies.Count-1 do
|
||||
if slTypelibs.IndexOf(TLI.Dependencies[j])=-1 then
|
||||
slTypelibs.Add(TLI.Dependencies[j]);
|
||||
except
|
||||
on E: Exception do ShowMessage(UTF16ToUTF8(E.Message));
|
||||
|
||||
// don't create package or ActiveX container for dependencies
|
||||
bPackage := False;
|
||||
bActiveX := False;
|
||||
for j := 0 to TLI.Dependencies.Count - 1 do
|
||||
if slTypelibs.IndexOf(TLI.Dependencies[j]) = -1 then
|
||||
slTypelibs.Add(TLI.Dependencies[j]);
|
||||
|
||||
except
|
||||
on E: Exception do
|
||||
ShowMessage(UTF16ToUTF8(E.Message));
|
||||
end;
|
||||
finally
|
||||
TLI.Destroy;
|
||||
end;
|
||||
finally
|
||||
TLI.destroy;
|
||||
end;
|
||||
i:=i+1;
|
||||
until not bRecurse or (i=slTypelibs.Count)
|
||||
i := i + 1;
|
||||
until not bRecurse or (i = slTypelibs.Count);
|
||||
end;
|
||||
finally
|
||||
FrmTL.Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FreeObjects(const strings: TStrings);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if strings.Count < 1 then
|
||||
exit;
|
||||
for i := 0 to Pred(strings.Count) do
|
||||
begin
|
||||
if Assigned(strings.Objects[i]) then
|
||||
begin
|
||||
try
|
||||
strings.Objects[i].Free;
|
||||
finally
|
||||
strings.Objects[i] := nil;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ReadDefaultVal(path: string; reg: TRegistry): string;
|
||||
begin
|
||||
reg.RootKey := HKEY_CLASSES_ROOT;
|
||||
if reg.OpenKeyReadOnly(path) then
|
||||
begin
|
||||
Result := reg.ReadString('');
|
||||
reg.CloseKey;
|
||||
end;
|
||||
end;
|
||||
|
||||
function EnumKeys(path: string; reg: TRegistry; lst: TStringList): boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if reg.OpenKeyReadOnly(path) then
|
||||
begin
|
||||
reg.GetKeyNames(lst);
|
||||
reg.CloseKey;
|
||||
if lst.Count > 0 then
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetTlbName(tlbid: string): string;
|
||||
var
|
||||
reg: TRegistry;
|
||||
subkeys: TStringList;
|
||||
key: string;
|
||||
Name: string;
|
||||
begin
|
||||
reg := Tregistry.Create;
|
||||
subkeys := TStringList.Create;
|
||||
try
|
||||
reg.RootKey := HKEY_CLASSES_ROOT;
|
||||
if reg.OpenKeyReadOnly('\TypeLib\' + tlbid) then
|
||||
begin
|
||||
reg.GetKeyNames(subkeys);
|
||||
reg.CloseKey;
|
||||
for key in subkeys do
|
||||
begin
|
||||
Name := ReadDefaultVal('\TypeLib\' + tlbid + '\' + key, reg);
|
||||
if length(Name) > 0 then
|
||||
begin
|
||||
Result := Name;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
subkeys.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
//some paths will have a c:\..\file.ocx\version appended on end..
|
||||
function ValidatePath(path: string): string;
|
||||
var
|
||||
a, b: integer;
|
||||
begin
|
||||
Result := path;
|
||||
a := LastDelimiter('.', path);
|
||||
b := LastDelimiter('\', path);
|
||||
if (b > a) and (a > 0) then
|
||||
Result := MidStr(path, 0, b - 1);
|
||||
end;
|
||||
|
||||
procedure LoadVisualControls(lst: TListBox);
|
||||
var
|
||||
reg: TRegistry;
|
||||
clsids: TStringList;
|
||||
e: TEntry;
|
||||
clsid: string;
|
||||
map: TStringList;
|
||||
const
|
||||
catid_control = '\Implemented Categories\{40FC6ED4-2438-11cf-A3DB-080036F12502}';
|
||||
begin
|
||||
lst.Clear;
|
||||
reg := TRegistry.Create;
|
||||
clsids := TStringList.Create;
|
||||
map := TStringList.Create;
|
||||
try
|
||||
reg.RootKey := HKEY_CLASSES_ROOT;
|
||||
if reg.OpenKeyReadOnly('\CLSID') then
|
||||
begin
|
||||
reg.GetKeyNames(clsids);
|
||||
reg.CloseKey;
|
||||
|
||||
for clsid in clsids do
|
||||
begin
|
||||
e := TEntry.Create;
|
||||
e.clsID := clsid;
|
||||
clsid := '\CLSID\' + clsid;
|
||||
|
||||
e.typeLib := ReadDefaultVal(clsid + '\TypeLib', reg);
|
||||
e.isControl := reg.KeyExists(clsID + '\Control');
|
||||
if not e.isControl then
|
||||
e.isControl := reg.KeyExists(clsID + catid_control);
|
||||
|
||||
if e.isControl and (length(e.typeLib) > 0) and
|
||||
(map.IndexOf(e.typeLib) = -1) then
|
||||
begin
|
||||
e.Name := GetTlbName(e.typeLib);
|
||||
if length(e.Name) > 0 then
|
||||
begin
|
||||
e.path := ReadDefaultVal(clsid + '\InprocServer32', reg);
|
||||
e.progID := ReadDefaultVal(clsid + '\ProgID', reg);
|
||||
e.version := ReadDefaultVal(clsid + '\Version', reg);
|
||||
map.Add(e.typeLib);
|
||||
lst.AddItem(e.Name, e);
|
||||
end;
|
||||
end
|
||||
else
|
||||
e.Free;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
clsids.Free;
|
||||
map.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoadActiveXLibs(lst: TListBox);
|
||||
var
|
||||
reg: TRegistry;
|
||||
clsids: TStringList;
|
||||
e: TEntry;
|
||||
clsid: string;
|
||||
vers: TStringList;
|
||||
revs: TStringList;
|
||||
map: TStringList;
|
||||
ver: string;
|
||||
begin
|
||||
lst.Clear;
|
||||
reg := TRegistry.Create;
|
||||
clsids := TStringList.Create;
|
||||
map := TStringList.Create;
|
||||
try
|
||||
reg.RootKey := HKEY_CLASSES_ROOT;
|
||||
if EnumKeys('\TypeLib', reg, clsids) then
|
||||
begin
|
||||
for clsid in clsids do
|
||||
begin
|
||||
e := TEntry.Create;
|
||||
e.clsID := clsid;
|
||||
|
||||
vers := TStringList.Create;
|
||||
if not EnumKeys('\TypeLib\' + clsid, reg, vers) then
|
||||
begin
|
||||
vers.Free;
|
||||
e.Free;
|
||||
continue;
|
||||
end;
|
||||
ver := vers[vers.Count - 1];
|
||||
revs := TStringList.Create;
|
||||
if not EnumKeys('\TypeLib\' + clsid + '\' + ver, reg, revs) then
|
||||
begin
|
||||
revs.Free;
|
||||
e.Free;
|
||||
continue;
|
||||
end;
|
||||
|
||||
e.Name := ReadDefaultVal('\TypeLib\' + clsID + '\' + ver, reg);
|
||||
e.path := ReadDefaultVal('\TypeLib\' + clsID + '\' + ver + '\' + revs[0] + '\win32', reg);
|
||||
e.version := ver + '.' + revs[0];
|
||||
e.path := ValidatePath(e.path);
|
||||
|
||||
if (length(e.Name) > 0) and (map.IndexOf(e.Name) = -1) and FileExists(e.path) then
|
||||
begin
|
||||
lst.AddItem(e.Name, e);
|
||||
map.Add(e.Name);
|
||||
end
|
||||
else
|
||||
e.Free;
|
||||
|
||||
vers.Free;
|
||||
revs.Free;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
reg.Free;
|
||||
clsids.Free;
|
||||
map.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFrmTL }
|
||||
|
||||
procedure TFrmTL.CBxTLActiveXChange(Sender: TObject);
|
||||
begin
|
||||
if not CBxTLActiveX.Checked then
|
||||
CBxTLPackage.Checked:=false;
|
||||
CBxTLPackage.Checked := False;
|
||||
end;
|
||||
|
||||
procedure TFrmTL.CBxTLPackageChange(Sender: TObject);
|
||||
begin
|
||||
if CBxTLPackage.Checked then
|
||||
CBxTLActiveX.Checked:=true;
|
||||
CBxTLActiveX.Checked := True;
|
||||
end;
|
||||
|
||||
procedure TFrmTL.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption:=axImportTypeLibrary;
|
||||
Label1.Caption:=axFileContainingTypeLibrary;
|
||||
CBxTLActiveX.Caption:=axCreateVisualComponentTActiveXContainerDescendant;
|
||||
CBxTLPackage.Caption:=axCreatePackage;
|
||||
CBxTLRecurse.Caption:=axConvertDependantTypelibs;
|
||||
FNETL.Filter:=axTypeLibraryFilesTlbDllExeOcxOlbTlbDllExeOcxOlbAllF;
|
||||
Caption := axImportTypeLibrary;
|
||||
Label1.Caption := axFileContainingTypeLibrary;
|
||||
CBxTLActiveX.Caption := axCreateVisualComponentTActiveXContainerDescendant;
|
||||
CBxTLPackage.Caption := axCreatePackage;
|
||||
CBxTLRecurse.Caption := axConvertDependantTypelibs;
|
||||
FNETL.Filter := axTypeLibraryFilesTlbDllExeOcxOlbTlbDllExeOcxOlbAllF;
|
||||
pagecontrol1.TabIndex := 0;
|
||||
lstcontrols.SetBounds(lstrefs.Left, lstrefs.Top, lstrefs.Width, lstrefs.Height);
|
||||
lstFiltered.SetBounds(lstrefs.Left + pagecontrol1.Left + 4, lstrefs.Top +
|
||||
pagecontrol1.Top + 4, lstrefs.Width, lstrefs.Height);
|
||||
LoadVisualControls(lstControls);
|
||||
end;
|
||||
|
||||
procedure TFrmTL.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeObjects(lstControls.items);
|
||||
FreeObjects(lstrefs.items);
|
||||
end;
|
||||
|
||||
procedure TFrmTL.ListClickHandler(lst: TListBox);
|
||||
var
|
||||
e: TEntry;
|
||||
begin
|
||||
try
|
||||
e := lst.Items.Objects[lst.ItemIndex] as TEntry;
|
||||
FNETL.Text := e.path;
|
||||
finally
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFrmTL.lstControlsClick(Sender: TObject);
|
||||
begin
|
||||
ListClickHandler(lstControls);
|
||||
end;
|
||||
|
||||
procedure TFrmTL.lstRefsClick(Sender: TObject);
|
||||
begin
|
||||
ListClickHandler(lstRefs);
|
||||
end;
|
||||
|
||||
procedure TFrmTL.lstFilteredClick(Sender: TObject);
|
||||
var
|
||||
lst: TListBox;
|
||||
s: string;
|
||||
i: integer;
|
||||
e: TEntry;
|
||||
begin
|
||||
if PageControl1.TabIndex = 1 then
|
||||
lst := lstRefs
|
||||
else
|
||||
lst := lstControls;
|
||||
s := lstFiltered.Items.Strings[lstfiltered.ItemIndex];
|
||||
i := lst.Items.IndexOf(s);
|
||||
if i < 0 then
|
||||
exit;
|
||||
try
|
||||
e := lst.Items.Objects[i] as TEntry;
|
||||
FNETL.Text := e.path;
|
||||
finally
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFrmTL.PageControl1Change(Sender: TObject);
|
||||
begin
|
||||
//loaded on depand to reduce startup time..
|
||||
if (PageControl1.TabIndex = 1) and (lstrefs.Items.Count = 0) then
|
||||
LoadActiveXLibs(lstRefs);
|
||||
txtsearch.Text := '';
|
||||
lstfiltered.Visible := False;
|
||||
end;
|
||||
|
||||
procedure TFrmTL.txtSearchChange(Sender: TObject);
|
||||
var
|
||||
i: integer;
|
||||
item: string;
|
||||
lst: TListBox;
|
||||
begin
|
||||
lstfiltered.Clear;
|
||||
if PageControl1.TabIndex = 1 then
|
||||
lst := lstRefs
|
||||
else
|
||||
lst := lstControls;
|
||||
|
||||
if length(txtsearch.Text) = 0 then
|
||||
begin
|
||||
lstfiltered.Visible := False;
|
||||
exit;
|
||||
end;
|
||||
|
||||
lstfiltered.Visible := True;
|
||||
|
||||
for i := 0 to lst.Items.Count - 1 do
|
||||
begin
|
||||
item := lst.Items.Strings[i];
|
||||
if AnsiContainsText(item, txtsearch.Text) then
|
||||
lstfiltered.items.Add(item);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user