mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-15 22:39:33 +01:00
6182f2d25d
- Added the optional creation of a lazarus design/runtime package for the activex container. - Added full files in case diff doesn't work. Fixes to typelib importer: - avoid duplicate enum members (translated to const) (Office10\MSWORD.OLB) - don't make TEventSink or TActiveXContainer descendants if interface does not descend from IDispatch (VBA6\VBE6EXT.OLB) - add type declaration for coclass interface pointing to default interface - fixed property setter for array properties - added typecasting for byref interface event parameters - typecasting workaround for pvarVal^ and pbstrVal^ "Can't take the address of constant expressions" error caused by var type mismatch OLEVariant <> Variant and POleStr<>WideString - reverted to the use of OLEVariant. POLEVariant isn't automatable in trunk but PVariant isn't automatable in 2.6.0 neither. - added byref VT_INT, VT_UINT, VT_DECIMAL event parameter support (Office10\MSWORD.OLB) - replace the use of TOleEnum with LongWord. Definition in ActiveX (type TOleEnum = type LongWord;) prohibits casting of OleVariant to TOleEnum.(Office10\MSOUTL.OLB) - disambiguate method name for INVOKE_PROPERTYPUT and INVOKE_PROPERTYPUTREF on same property (ado\msado25.tlb) - postpone interface declaration until full declaration of ancestor class. git-svn-id: trunk@20157 -
92 lines
2.7 KiB
ObjectPascal
92 lines
2.7 KiB
ObjectPascal
program importtl;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$apptype console}
|
|
uses
|
|
classes,typelib,sysutils;
|
|
|
|
var
|
|
unitname,sPackageSource,sPackageRegUnitSource:string;
|
|
sTL,sOutDir:string;
|
|
F:text;
|
|
slDep:TStringList;
|
|
i:integer;
|
|
bNoRecurse,bHelp,bActiveX,bPackage:boolean;
|
|
begin
|
|
slDep:=TStringList.Create;
|
|
bNoRecurse:=false;
|
|
bHelp:=false;
|
|
bActiveX:=false;
|
|
bPackage:=false;
|
|
i:=1;
|
|
while i<=Paramcount do
|
|
begin
|
|
if pos('-n',ParamStr(i))>0 then bNoRecurse:=true
|
|
else if pos('-a',ParamStr(i))>0 then bActiveX:=true
|
|
else if pos('-h',ParamStr(i))>0 then bHelp:=true
|
|
else if pos('-p',ParamStr(i))>0 then bPackage:=true
|
|
else if pos('-d',ParamStr(i))>0 then
|
|
begin
|
|
sOutDir:=trim(copy(ParamStr(i), pos('-d',ParamStr(i))+2, 260)); // windows MAX_PATH
|
|
if sOutDir='' then
|
|
if i<Paramcount-1 then
|
|
begin
|
|
i:=i+1;
|
|
sOutDir:=trim(ParamStr(i));
|
|
end
|
|
else
|
|
begin
|
|
bHelp:=true;
|
|
sOutDir:='\';
|
|
end;
|
|
if not (sOutDir[length(sOutDir)] in [':','\']) then
|
|
sOutDir:=sOutDir+'\';
|
|
end;
|
|
i:=i+1;
|
|
end;
|
|
if bHelp or (Paramcount=0) or (pos('-',paramstr(Paramcount))=1) then
|
|
begin
|
|
writeln('Usage: importtl [options] file');
|
|
writeln('Reads type information from "file" and converts it into a freepascal binding');
|
|
writeln('units.');
|
|
writeln('Options.');
|
|
writeln(' -h : displays this text.');
|
|
writeln(' -a : create ActiveXContainer descendants');
|
|
writeln(' -d dir: set output directory. Default: current directory.');
|
|
writeln(' -n : do not recurse typelibs. Default: create bindingss for all');
|
|
writeln(' dependencies.');
|
|
writeln(' -p : create lazarus package for ActiveXContainer descendants');
|
|
exit;
|
|
end;
|
|
slDep.Add(paramstr(Paramcount));
|
|
i:=0;
|
|
repeat
|
|
writeln('Reading typelib from '+slDep[i]+ ' ...');
|
|
sTL:=ImportTypelib(slDep[i],unitname,slDep,bActiveX,bPackage,sPackageSource,sPackageRegUnitSource);
|
|
unitname:=sOutDir+unitname;
|
|
if (bPackage) and (sPackageSource<>'') then
|
|
begin
|
|
writeln('Writing package file to '+unitname+'P.lpk' );
|
|
AssignFile(F,unitname+'P.lpk');
|
|
Rewrite(F);
|
|
Write(F,sPackageSource);
|
|
CloseFile(F);
|
|
writeln('Writing package registration file to '+unitname+'Preg.pas');
|
|
AssignFile(F,unitname+'Preg.pas');
|
|
Rewrite(F);
|
|
Write(F,sPackageSource);
|
|
CloseFile(F);
|
|
end;
|
|
bActiveX:=false; //don't create ActiveXContainer descendants in descendants
|
|
bPackage:=false;
|
|
writeln('Writing to '+unitname+'.pas');
|
|
AssignFile(F,unitname+'.pas');
|
|
Rewrite(F);
|
|
Write(F,sTL);
|
|
CloseFile(F);
|
|
i:=i+1;
|
|
until bNoRecurse or (i=slDep.Count);
|
|
slDep.Destroy;
|
|
end.
|
|
|