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
|
unit ImportTypelib;
{$mode objfpc}{$H+}
interface
{$ifndef wince}
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
StdCtrls, ButtonPanel, lazideintf, projectintf, PackageIntf, activexstrconsts,
LazUTF8;
type
{ TFrmTL }
TFrmTL = class(TForm)
ButtonPanel: TButtonPanel;
CBxTLActiveX: TCheckBox;
CBxTLPackage: TCheckBox;
CBxTLRecurse: TCheckBox;
FNETL: TFileNameEdit;
Label1: TLabel;
SelectDirectoryDialog1: TSelectDirectoryDialog;
procedure CBxTLActiveXChange(Sender: TObject);
procedure CBxTLPackageChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
FrmTL: TFrmTL;
procedure ImpTypeLib(Sender: TObject);
{$endif wince}
implementation
{$ifndef wince}
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
begin
FrmTL:= TFrmTL.create(nil);
try
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;
try
TLI.Execute;
sUnitName:=SysToUTF8(TLI.UnitName);
if bPackage then
begin
with FrmTL.SelectDirectoryDialog1 do
begin
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
begin
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
begin //save in same dir as package
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));
end;
finally
TLI.destroy;
end;
i:=i+1;
until not bRecurse or (i=slTypelibs.Count)
end;
finally
FrmTL.Destroy;
end;
end;
{ TFrmTL }
procedure TFrmTL.CBxTLActiveXChange(Sender: TObject);
begin
if not CBxTLActiveX.Checked then
CBxTLPackage.Checked:=false;
end;
procedure TFrmTL.CBxTLPackageChange(Sender: TObject);
begin
if CBxTLPackage.Checked then
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;
end;
{$R *.lfm}
{$endif wince}
end.
|
