* StdOle2 and typelib added from Ludo Brands (bug 20958)

git-svn-id: trunk@19887 -

.gitattributes

@@ -6500,7 +6500,9 @@ packages/winunits-base/src/richedit.pp svneol=native#text/plain
 packages/winunits-base/src/shellapi.pp svneol=native#text/plain
 packages/winunits-base/src/shfolder.pp svneol=native#text/plain
 packages/winunits-base/src/shlobj.pp svneol=native#text/plain
+packages/winunits-base/src/stdole2.pas svneol=native#text/plain
 packages/winunits-base/src/tmschema.inc svneol=native#text/plain
+packages/winunits-base/src/typelib.pas svneol=native#text/plain
 packages/winunits-base/src/uxtheme.pp svneol=native#text/plain
 packages/winunits-base/src/win9xwsmanager.pp svneol=native#text/pascal
 packages/winunits-base/src/wininet.pp svneol=native#text/plain

packages/winunits-base/Makefile.fpc

@@ -13,7 +13,7 @@ packages=fcl-registry fcl-base
 units=buildwinutilsbase
 implicitunits=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver \
 	shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv winspool imm imm_dyn nb30 \
-        win9xwsmanager
+        win9xwsmanager stdole2 typelib
 
 examples=examples
 

packages/winunits-base/fpmake.pp

@@ -56,6 +56,8 @@ begin
           AddUnit('multimon');
           AddUnit('htmlhelp');
           AddUnit('winspool');
+		  AddUnit('stdole2');
+		  AddUnit('typelib');
         end;
     T:=P.Targets.AddImplicitUnit('activex.pp');
     T:=P.Targets.AddImplicitUnit('comconst.pp');
@@ -80,6 +82,8 @@ begin
     T:=P.Targets.AddImplicitUnit('dwmapi.pp');
     T:=P.Targets.AddImplicitUnit('htmlhelp.pp');
     T:=P.Targets.AddImplicitUnit('winspool.pp');
+	T:=P.Targets.AddImplicitUnit('stdole2');
+	T:=P.Targets.AddImplicitUnit('typelib');
     T.Dependencies.AddInclude('tmschema.inc');
     P.ExamplePath.Add('tests/');
     P.Targets.AddExampleProgram('testcom1.pp');

packages/winunits-base/src/buildwinutilsbase.pp

@@ -24,7 +24,8 @@ uses
     flatsb, winver, mmsystem, comconst, commctrl, comobj, commdlg,
     ole2, activex, shellapi, shlobj, oleserver,  shfolder, richedit,
     imagehlp, wininet, uxtheme, dwmapi, multimon, htmlhelp, winutils,
-    comserv, winspool, imm, imm_dyn, nb30, win9xwsmanager;
+    comserv, winspool, imm, imm_dyn, nb30, win9xwsmanager, stdole2, 
+	typelib;
 
 implementation
 

packages/winunits-base/src/stdole2.pas

@@ -0,0 +1,286 @@
+Unit stdole2;
+
+//  Imported on 24/12/2011 13:43:11 from C:\WINDOWS\system32\stdole2.tlb
+//  Modified by Ludo Brands to remove redeclarations
+//  Warning: renamed method 'Reset' in IEnumVARIANT to 'Reset_'
+//  Warning: renamed property 'Type' in IPicture to 'Type_'
+//  Warning: 'pointer' not automatable in Picturedisp.Render
+//  Warning: renamed property 'Type' in Picture to 'Type_'
+
+{$mode delphi}{$H+}
+
+interface
+uses Windows, ActiveX, Classes, OleServer, Variants;
+Const
+  stdoleMajorVersion = 2;
+  stdoleMinorVersion = 0;
+
+  LIBID_stdole : TGUID = '{00020430-0000-0000-C000-000000000046}';
+
+  IID_IUnknown : TGUID = '{00000000-0000-0000-C000-000000000046}';
+  IID_IDispatch : TGUID = '{00020400-0000-0000-C000-000000000046}';
+  IID_IEnumVARIANT : TGUID = '{00020404-0000-0000-C000-000000000046}';
+  IID_IFont : TGUID = '{BEF6E002-A874-101A-8BBA-00AA00300CAB}';
+  IID_Font : TGUID = '{BEF6E003-A874-101A-8BBA-00AA00300CAB}';
+  CLASS_StdFont : TGUID = '{0BE35203-8F91-11CE-9DE3-00AA004BB851}';
+  IID_IPicture : TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}';
+  IID_Picture : TGUID = '{7BF80981-BF32-101A-8BBB-00AA00300CAB}';
+  CLASS_StdPicture : TGUID = '{0BE35204-8F91-11CE-9DE3-00AA004BB851}';
+  IID_FontEvents : TGUID = '{4EF6100A-AF88-11D0-9846-00C04FC29993}';
+
+//Enums
+Type
+  OLE_TRISTATE =TOleEnum;
+Const
+  Unchecked = $0000000000000000;
+  Checked = $0000000000000001;
+  Gray = $0000000000000002;
+Type
+  LoadPictureConstants =TOleEnum;
+Const
+  Default = $0000000000000000;
+  Monochrome = $0000000000000001;
+  VgaColor = $0000000000000002;
+  Color = $0000000000000004;
+
+//Forward declarations
+Type
+ IEnumVARIANT = interface;
+ IFont = interface;
+ Font = dispinterface;
+ IPicture = interface;
+ Picture = dispinterface;
+ FontEvents = dispinterface;
+
+//records, unions, aliases
+ EXCEPINFO = packed record
+     wCode : Word;
+     wReserved : Word;
+     bstrSource : WideString;
+     bstrDescription : WideString;
+     bstrHelpFile : WideString;
+     dwHelpContext : LongWord;
+     pvReserved : Ppointer;
+     pfnDeferredFillIn : Ppointer;
+     scode : SCODE;
+ end;
+     OLE_COLOR = LongWord;
+     OLE_XPOS_PIXELS = Integer;
+     OLE_YPOS_PIXELS = Integer;
+     OLE_XSIZE_PIXELS = Integer;
+     OLE_YSIZE_PIXELS = Integer;
+     OLE_XPOS_HIMETRIC = Integer;
+     OLE_YPOS_HIMETRIC = Integer;
+     OLE_XSIZE_HIMETRIC = Integer;
+     OLE_YSIZE_HIMETRIC = Integer;
+     OLE_XPOS_CONTAINER = Single;
+     OLE_YPOS_CONTAINER = Single;
+     OLE_XSIZE_CONTAINER = Single;
+     OLE_YSIZE_CONTAINER = Single;
+     OLE_HANDLE = SYSINT;
+     OLE_OPTEXCLUSIVE = WordBool;
+     OLE_CANCELBOOL = WordBool;
+     OLE_ENABLEDEFAULTBOOL = WordBool;
+     FONTNAME = WideString;
+     FONTSIZE = Currency;
+     FONTBOLD = WordBool;
+     FONTITALIC = WordBool;
+     FONTUNDERSCORE = WordBool;
+     FONTSTRIKETHROUGH = WordBool;
+     IFontDisp = Font;
+     IPictureDisp = Picture;
+     IFontEventsDisp = FontEvents;
+
+//interface declarations
+
+// IEnumVARIANT :
+
+ IEnumVARIANT = interface(IUnknown)
+   ['{00020404-0000-0000-C000-000000000046}']
+    // Next :  
+   procedure Next(celt:LongWord;var rgvar:OleVariant;out pceltFetched:LongWord);stdcall;
+    // Skip :  
+   procedure Skip(celt:LongWord);stdcall;
+    // Reset_ :  
+   procedure Reset_;stdcall;
+    // Clone :  
+   procedure Clone(out ppenum:IEnumVARIANT);stdcall;
+  end;
+
+// IFont : Font Object
+
+ IFont = interface(IUnknown)
+   ['{BEF6E002-A874-101A-8BBA-00AA00300CAB}']
+   function Get_Name : WideString; stdcall;
+   procedure Set_Name(const pname:WideString); stdcall;
+   function Get_Size : Currency; stdcall;
+   procedure Set_Size(const psize:Currency); stdcall;
+   function Get_Bold : WordBool; stdcall;
+   procedure Set_Bold(const pbold:WordBool); stdcall;
+   function Get_Italic : WordBool; stdcall;
+   procedure Set_Italic(const pitalic:WordBool); stdcall;
+   function Get_Underline : WordBool; stdcall;
+   procedure Set_Underline(const punderline:WordBool); stdcall;
+   function Get_Strikethrough : WordBool; stdcall;
+   procedure Set_Strikethrough(const pstrikethrough:WordBool); stdcall;
+   function Get_Weight : Smallint; stdcall;
+   procedure Set_Weight(const pweight:Smallint); stdcall;
+   function Get_Charset : Smallint; stdcall;
+   procedure Set_Charset(const pcharset:Smallint); stdcall;
+   function Get_hFont : OLE_HANDLE; stdcall;
+    // Clone :  
+   procedure Clone(out ppfont:IFont);stdcall;
+    // IsEqual :  
+   procedure IsEqual(pfontOther:IFont);stdcall;
+    // SetRatio :  
+   procedure SetRatio(cyLogical:Integer;cyHimetric:Integer);stdcall;
+    // AddRefHfont :  
+   procedure AddRefHfont(hFont:OLE_HANDLE);stdcall;
+    // ReleaseHfont :  
+   procedure ReleaseHfont(hFont:OLE_HANDLE);stdcall;
+    // Name :  
+   property Name:WideString read Get_Name write Set_Name;
+    // Size :  
+   property Size:Currency read Get_Size write Set_Size;
+    // Bold :  
+   property Bold:WordBool read Get_Bold write Set_Bold;
+    // Italic :  
+   property Italic:WordBool read Get_Italic write Set_Italic;
+    // Underline :  
+   property Underline:WordBool read Get_Underline write Set_Underline;
+    // Strikethrough :  
+   property Strikethrough:WordBool read Get_Strikethrough write Set_Strikethrough;
+    // Weight :  
+   property Weight:Smallint read Get_Weight write Set_Weight;
+    // Charset :  
+   property Charset:Smallint read Get_Charset write Set_Charset;
+    // hFont :  
+   property hFont:OLE_HANDLE read Get_hFont ;
+  end;
+
+// Font : 
+
+ Font = dispinterface
+   ['{BEF6E003-A874-101A-8BBA-00AA00300CAB}']
+    // Name :  
+   property Name:WideString  dispid 0;
+    // Size :  
+   property Size:Currency  dispid 2;
+    // Bold :  
+   property Bold:WordBool  dispid 3;
+    // Italic :  
+   property Italic:WordBool  dispid 4;
+    // Underline :  
+   property Underline:WordBool  dispid 5;
+    // Strikethrough :  
+   property Strikethrough:WordBool  dispid 6;
+    // Weight :  
+   property Weight:Smallint  dispid 7;
+    // Charset :  
+   property Charset:Smallint  dispid 8;
+  end;
+
+// IPicture : Picture Object
+
+ IPicture = interface(IUnknown)
+   ['{7BF80980-BF32-101A-8BBB-00AA00300CAB}']
+   function Get_Handle : OLE_HANDLE; stdcall;
+   function Get_hPal : OLE_HANDLE; stdcall;
+   function Get_Type_ : Smallint; stdcall;
+   function Get_Width : OLE_XSIZE_HIMETRIC; stdcall;
+   function Get_Height : OLE_YSIZE_HIMETRIC; stdcall;
+    // Render :  
+   procedure Render(hdc:SYSINT;x:Integer;y:Integer;cx:Integer;cy:Integer;xSrc:OLE_XPOS_HIMETRIC;ySrc:OLE_YPOS_HIMETRIC;cxSrc:OLE_XSIZE_HIMETRIC;cySrc:OLE_YSIZE_HIMETRIC;var prcWBounds:pointer);stdcall;
+   procedure Set_hPal(const phpal:OLE_HANDLE); stdcall;
+   function Get_CurDC : SYSINT; stdcall;
+    // SelectPicture :  
+   procedure SelectPicture(hdcIn:SYSINT;out phdcOut:SYSINT;out phbmpOut:OLE_HANDLE);stdcall;
+   function Get_KeepOriginalFormat : WordBool; stdcall;
+   procedure Set_KeepOriginalFormat(const pfkeep:WordBool); stdcall;
+    // PictureChanged :  
+   procedure PictureChanged;stdcall;
+    // SaveAsFile :  
+   procedure SaveAsFile(var pstm:pointer;fSaveMemCopy:WordBool;out pcbSize:Integer);stdcall;
+   function Get_Attributes : Integer; stdcall;
+    // SetHdc :  
+   procedure SetHdc(hdc:OLE_HANDLE);stdcall;
+    // Handle :  
+   property Handle:OLE_HANDLE read Get_Handle ;
+    // hPal :  
+   property hPal:OLE_HANDLE read Get_hPal write Set_hPal;
+    // Type :  
+   property Type_:Smallint read Get_Type_ ;
+    // Width :  
+   property Width:OLE_XSIZE_HIMETRIC read Get_Width ;
+    // Height :  
+   property Height:OLE_YSIZE_HIMETRIC read Get_Height ;
+    // CurDC :  
+   property CurDC:SYSINT read Get_CurDC ;
+    // KeepOriginalFormat :  
+   property KeepOriginalFormat:WordBool read Get_KeepOriginalFormat write Set_KeepOriginalFormat;
+    // Attributes :  
+   property Attributes:Integer read Get_Attributes ;
+  end;
+
+// Picture : 
+
+ Picture = dispinterface
+   ['{7BF80981-BF32-101A-8BBB-00AA00300CAB}']
+    // Render :  
+   procedure Render(hdc:SYSINT;x:Integer;y:Integer;cx:Integer;cy:Integer;xSrc:OLE_XPOS_HIMETRIC;ySrc:OLE_YPOS_HIMETRIC;cxSrc:OLE_XSIZE_HIMETRIC;cySrc:OLE_YSIZE_HIMETRIC;prcWBounds:{!! pointer !!} OleVariant);dispid 6;
+    // Handle :  
+   property Handle:OLE_HANDLE  dispid 0;
+    // hPal :  
+   property hPal:OLE_HANDLE  dispid 2;
+    // Type :  
+   property Type_:Smallint  dispid 3;
+    // Width :  
+   property Width:OLE_XSIZE_HIMETRIC  dispid 4;
+    // Height :  
+   property Height:OLE_YSIZE_HIMETRIC  dispid 5;
+  end;
+
+// FontEvents : Event interface for the Font object
+
+ FontEvents = dispinterface
+   ['{4EF6100A-AF88-11D0-9846-00C04FC29993}']
+    // FontChanged :  
+   procedure FontChanged(PropertyName:WideString);dispid 9;
+  end;
+
+//CoClasses
+  CoStdFont =class
+    class function Create: Font;
+    class function CreateRemote(const MachineName: string): Font;
+  end;
+  CoStdPicture =class
+    class function Create: Picture;
+    class function CreateRemote(const MachineName: string): Picture;
+  end;
+
+implementation
+
+uses comobj;
+
+class function CoStdFont.Create: Font;
+begin
+  Result := CreateComObject(CLASS_StdFont) as Font;
+end;
+
+class function CoStdFont.CreateRemote(const MachineName: string): Font;
+begin
+  Result := CreateRemoteComObject(MachineName,CLASS_StdFont) as Font;
+end;
+
+class function CoStdPicture.Create: Picture;
+begin
+  Result := CreateComObject(CLASS_StdPicture) as Picture;
+end;
+
+class function CoStdPicture.CreateRemote(const MachineName: string): Picture;
+begin
+  Result := CreateRemoteComObject(MachineName,CLASS_StdPicture) as Picture;
+end;
+
+
+end.

packages/winunits-base/src/typelib.pas

@@ -0,0 +1,1130 @@
+unit typelib;
+
+{$mode objfpc}{$H+}
+
+{ Typelib import routines.
+
+  Creates freepascal bindings for COM objects stored in .tlb, .dll, .exe or .olb files.
+
+  Copyright (C) 2011 Ludo Brands
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+interface
+
+uses
+  Classes, SysUtils,comobj,activex,windows;
+
+{
+Reads type information from 'FileName' and converts it in a freepascal binding unit. The
+contents of the unit is returned as the function result.
+Returns in 'sUnitName' the unit name with '.pas' extension.
+Appends to 'slDependencies' the filenames of the additional typelibs needed.
+
+By default, the type library is extracted from the first resource of type ITypeLib.
+To load a different type of library resource, append an integer index to 'FileName'.
+
+Example:  C:\WINDOWS\system32\msvbvm60.dll\3
+}
+function ImportTypelib(FileName: WideString;var sUnitName:string;var slDependencies:TStringList):string;
+
+
+Type
+
+  { TTypeLibImporter }
+
+  TTypeLibImporter = Class(TComponent)
+  private
+    FAppendVersionNumber: Boolean;
+    FDependencies: TStringList;
+    FUnitSource: TStringList;
+    FInputFileName: WideString;
+    FOutputFileName: String;
+    FUnitname: string;
+    FUses : TStrings;
+    FHeader : TStrings;
+    FInterface : TStrings;
+    FImplementation : TStrings;
+    procedure CreateCoClasses(const TL: ITypeLib; TICount: Integer);
+    procedure CreateForwards(const TL: ITypeLib; TICount: Integer);
+    procedure CreateInterfaces(const TL: ITypeLib; TICount: Integer);
+    procedure CreateRecordsUnionsAliases(const TL: ITypeLib; TICount: Integer);
+    procedure CreateUnitHeader(const TL: ITypeLib; const LA: lpTLIBATTR);
+    function GetDependencies: TStrings;
+    function GetUnitSource: TStrings;
+    procedure ImportEnums(const TL: ITypeLib; TICount: Integer);
+    procedure ImportGUIDs(const TL: ITypeLib; TICount: Integer);
+    procedure SetOutputFileName(AValue: String);
+    procedure SetUnitName(AValue: string);
+  Protected
+    bIsCustomAutomatable,bIsInterface,bIsAutomatable:boolean;
+    // Construct unit from header, uses, interface,
+    procedure BuildUnit; virtual;
+    // Add to various parts of sources
+    Procedure AddToUses(Const AUnit : String); virtual;
+    Procedure AddToHeader(Const ALine : String; AllowDuplicate : Boolean = False);virtual;
+    Procedure AddToHeader(Const Fmt : String; Args : Array of const; AllowDuplicate : Boolean = False);
+    Procedure AddToInterface(Const ALine : String);virtual;
+    Procedure AddToInterface(Const Fmt : String; Args : Array of const);
+    Procedure AddToImplementation(Const ALine : String);virtual;
+    Procedure AddToImplementation(Const Fmt : String; Args : Array of const);
+    // utility functions
+    function interfacedeclaration(iName, iDoc: string; TI: ITypeInfo; TA: LPTYPEATTR; bIsDispatch: boolean): string;
+    function VarTypeIsAutomatable(ParamType: integer): boolean; virtual;
+    function VarTypeToStr(ParamType: integer): string; virtual;
+    function TypeToString(TI: ITypeInfo; TD: TYPEDESC): string; virtual;
+    function ValidateID(id: string): boolean; virtual;
+    // The actual routine that does the work.
+    Procedure DoImportTypelib;virtual;
+    // For the benefit of descendents;
+    Property UsesClause : TStrings read FUses;
+    Property Header : TStrings read FHeader;
+    Property InterfaceSection : TStrings Read FInterface;
+    Property ImplementationSection : TStrings Read FImplementation;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Execute;
+    Property Dependencies : TStrings Read GetDependencies;
+    Property UnitSource : TStrings Read GetUnitSource;
+  Published
+    // Append version number to unit name.
+    Property AppendVersionNumber : Boolean Read FAppendVersionNumber Write FAppendVersionNumber Default True;
+    // File to read typelib from.
+    Property InputFileName : WideString Read FInputFileName Write FInputFileName;
+    // If set, unit source will be written to this file.
+    Property OutputFileName : String Read FOutputFileName Write SetOutputFileName;
+    // Set automatically by OutputFileName or by Execute
+    Property UnitName : string Read FUnitname Write SetUnitName;
+  end;
+
+
+implementation
+
+Resourcestring
+  SErrInvalidUnitName = 'Invalid unit name : %s';
+
+function ImportTypelib(FileName: WideString;var sUnitName:string;var slDependencies:TStringList):string;
+var i:integer;
+begin
+  With TTypeLibImporter.Create(Nil) do
+    try
+      InputFileName:=FileName;
+      Execute;
+      Result:=UnitSource.Text;
+      sUnitname:=UnitName+'.pas';
+      if Assigned(slDependencies) then
+        begin  //add new dependencies
+        for i:=0 to Dependencies.Count-1 do
+          if slDependencies.IndexOf(Dependencies[i])=-1 then
+            slDependencies.Add(Dependencies[i]);
+        end;
+    finally
+      Free;
+    end;
+end;
+
+function TTypeLibImporter.VarTypeIsAutomatable(ParamType:integer): boolean;
+
+begin
+result:=ParamType in [vt_i1,vt_ui1,vt_i2,vt_ui2,vt_i4,vt_ui4,vt_uint,
+            vt_i8,VT_UI8,vt_bool,vt_r4,vt_r8,vt_cy,vt_date,
+            VT_BSTR,VT_VARIANT,VT_DISPATCH,VT_UNKNOWN,vt_hresult,VT_INT];
+end;
+
+function TTypeLibImporter.VarTypeToStr(ParamType:integer): string;
+
+begin
+  case ParamType of
+    vt_empty : Result := 'Empty';
+    vt_null : Result := 'Null';
+    vt_i2 : Result := 'Smallint';
+    vt_i4 : Result := 'Integer';
+    vt_r4 : Result := 'Single';
+    vt_r8 : Result := 'Double';
+    vt_cy : Result := 'Currency';
+    vt_date : Result := 'TDateTime';
+    vt_bstr : Result := 'WideString';
+    vt_dispatch  : Result := 'IDispatch';
+    vt_error : Result := 'SCODE';
+    vt_bool : Result := 'WordBool';
+    vt_variant : Result := 'OleVariant';
+    vt_unknown : Result := 'IUnknown';
+    vt_i1  : Result := 'ShortInt';
+    vt_ui1 : Result := 'Byte';
+    vt_ui2 : Result := 'Word';
+    vt_ui4  : Result := 'LongWord';
+    vt_i8 : Result := 'Int64';
+    VT_UI8: Result := 'QWord';
+    vt_clsid : Result := 'TGUID';
+    vt_void : Result := 'pointer';
+    vt_ptr : Result := 'Pointer';
+    vt_uint : Result := 'UInt';
+    vt_userdefined : Result := 'User defined';
+    vt_hresult : Result := 'HResult';
+    VT_INT:Result:='SYSINT';
+    VT_SAFEARRAY:Result:='PSafeArray';
+  else
+    Result := 'Unknown (' + IntToStr(ParamType) + ')';
+  end;
+end;
+
+function TTypeLibImporter.ValidateID(id:string):boolean;
+
+const
+  RESERVEDCNT=111;
+  RESERVED:array[1..RESERVEDCNT] of string=
+  ('absolute','and','array','asm','begin','break','case','const',
+  'constructor','continue','destructor','div','do','downto','else','end',
+  'file','for','function','goto','if','implementation','in','inherited',
+  'inline','interface','label','mod','nil','not','object','of',
+  'on','operator','or','packed','procedure','program','record','reintroduce',
+  'repeat','self','set','shl','shr','string','then','to',
+  'type','unit','until','uses','var','while','with','xor',
+  'as','class','except','exports','finalization','finally','initialization',
+  'is','library','on','property','raise','threadvar','try',
+  'dispose','exit','false','new','true',
+  'abs','arctan','boolean','char','cos','dispose','eof','eoln',
+  'exp','false','input','integer','ln','maxint','new','odd',
+  'ord','output','pack','page','pred','read','readln','real',
+  'reset','rewrite','round','sin','sqr','sqrt','succ','text',
+  'true','trunc','write','writeln');
+
+var
+  sl:string;
+  i:integer;
+
+begin
+  sl:=lowercase(id);
+  result:=true;
+  for i:=1 to RESERVEDCNT do
+    if sl= RESERVED[i] then
+      begin
+      result:=false;
+      break;
+      end;
+end;
+
+
+function TTypeLibImporter.TypeToString(TI:ITypeInfo; TD:TYPEDESC):string;
+
+var
+  TIref: ITypeInfo;
+  TARef:LPTYPEATTR;
+  TLRef: ITypeLib;
+  LARef: lpTLIBATTR;
+  BstrName : WideString;
+  il:LongWord;
+  i,idims:integer;
+  sl,sRefSrc,sKey:string;
+  Handle:HKEY;
+  bWasPointer:boolean;
+begin
+  result:='';
+  bIsCustomAutomatable:=false;
+  bIsInterface:=false;
+  if (TD.vt=vt_userdefined) or ((TD.vt=VT_PTR) and (TD.lptdesc^.vt=vt_userdefined)) then
+    begin
+    // interface references are dealt with now because they are pointers in fpc.
+    // Recursive algorithm makes it difficult to remove a single preceding 'P' from the result.
+    bWasPointer:=(TD.vt=VT_PTR);
+    if bWasPointer then
+      TD:=TD.lptdesc^;
+    OleCheck(TI.GetRefTypeInfo(TD.hreftype,TIref));
+    OleCheck(TIRef.GetDocumentation(DISPID_UNKNOWN, @BstrName, nil, nil, nil));
+    result:=BstrName;
+    OleCheck(TIRef.GetTypeAttr(TARef));
+    bIsCustomAutomatable:=TARef^.typekind in [TKIND_DISPATCH,TKIND_INTERFACE,TKIND_ENUM];
+    if TARef^.typekind=TKIND_ALIAS then
+      begin
+      TypeToString(TIRef,TARef^.tdescAlias); //not interested in result, only bIsCustomAutomatable and bIsInterface
+      bIsCustomAutomatable:=bIsAutomatable;
+      end
+    else
+      bIsInterface:=TARef^.typekind in [TKIND_DISPATCH,TKIND_INTERFACE] ;
+    if bWasPointer and not bIsInterface then  // interfaces are pointers to interface in fpc
+      result:='P'+result;
+    OleCheck(TIRef.GetContainingTypeLib(TLRef,il));
+    OleCheck(TLRef.GetDocumentation(-1, @BstrName, nil, nil, nil));
+    OleCheck(TLRef.GetLibAttr(LARef));
+    if FAppendVersionNumber then
+      sl:=format('%s_%d_%d_TLB',[BstrName,LARef^.wMajorVerNum,LARef^.wMinorVerNum])
+    else
+      sl:=format('%s_TLB',[BstrName]);
+    if (LowerCase(BstrName)='stdole') then // don't include, uses pre-defined stdole2.pas if V2
+      begin
+      if (LARef^.wMajorVerNum=2) and (FUses.IndexOf('stdole2')=-1) then
+        begin
+        AddToHeader('// Dependency: stdole v2 (stdole2.pas)');
+        FUses.Add('stdole2');
+        end;
+      end
+    else if (LowerCase(sl)<>LowerCase(UnitName)) and (FUses.IndexOf(sl)=-1) then
+      begin  // add dependency
+      // find source in registry key HKEY_CLASSES_ROOT\TypeLib\GUID\version\0\win32
+      il:=MAX_PATH;
+      SetLength(sRefSrc,il);
+      sKey:=format('\TypeLib\%s\%d.%d\0\win32',[GUIDToString(LARef^.GUID),LARef^.wMajorVerNum,LARef^.wMinorVerNum]);
+      if (RegOpenKeyEx(HKEY_CLASSES_ROOT,pchar(sKey),0,KEY_READ,Handle) = ERROR_SUCCESS) then
+        begin
+        if RegQueryValue(Handle,nil,@sRefSrc[1],@il) = ERROR_SUCCESS then
+          begin
+          SetLength(sRefSrc,il-1);  // includes null terminator
+          if not FDependencies.Find(sRefSrc,i) then
+            FDependencies.Add(sRefSrc);
+          end
+        else
+          sRefSrc:=GUIDToString(LARef^.GUID);
+        RegCloseKey(Handle);
+        end;
+      AddToHeader('// Dependency: %s v%d.%d (%s)',[BstrName,LARef^.wMajorVerNum,LARef^.wMinorVerNum,sRefSrc]);
+      FUses.Add(sl);
+      TLRef.ReleaseTLibAttr(LARef);
+      end;
+    TIRef.ReleaseTypeAttr(TARef);
+    end
+  else if TD.vt=VT_PTR then //pointer type
+    begin
+    TD:=TD.lptdesc^;
+    result:='P'+TypeToString(TI,TD);
+    bIsAutomatable:=(VarTypeIsAutomatable(TD.vt) and (TD.vt<>VT_VARIANT)) or bIsCustomAutomatable;
+    exit;
+    end
+  else if TD.vt=VT_CARRAY then //C type array
+    begin
+    // get array element type
+    sl:=TypeToString(TI,TD.lpadesc^.tdescElem);
+    // get dimensions
+    idims:=TD.lpadesc^.cDims;
+    result:='array[';
+    // get boundaries for every dimension
+    for i:=0 to idims-1 do
+      result:=result+IntToStr(TD.lpadesc^.rgbounds[i].lLbound)+'..'+IntToStr(TD.lpadesc^.rgbounds[i].cElements - TD.lpadesc^.rgbounds[i].lLbound -1)+',';
+    result[length(result)]:=']';
+    result:=result + ' of '+sl;
+    end
+  else
+    result:=VarTypeToStr(TD.vt);
+  bIsAutomatable:=VarTypeIsAutomatable(TD.vt) or bIsCustomAutomatable;
+end;
+
+function TTypeLibImporter.interfacedeclaration(iName,iDoc:string;TI:ITypeInfo;TA:LPTYPEATTR;bIsDispatch:boolean):string;
+
+type
+  TPropertyDef=record
+    idispid:integer;
+    bput,bget:boolean;
+    iptype,igtype:integer;
+    name,
+    sptype,          // only used if iptype=igtype
+    sorgname,
+    sdoc,
+    sParam,
+    sDefault:string;
+  end;
+
+var
+  RTIT: HREFTYPE;
+  TIref: ITypeInfo;
+  BstrName,BstrNameRef,BstrDocString : WideString;
+  s,sl,sPropIntfc,sPropDispIntfc,sType,sConv,sFunc,sVarName,sMethodName,sPropParam,sPropParam2:string;
+  i,j,k:integer;
+  FD: lpFUNCDESC;
+  BL : array[0..99] of TBstr;
+  cnt:LongWord;
+  TD: TYPEDESC;
+  bPropHasParam,bIsFunction:boolean;
+  VD: lpVARDESC;
+  aPropertyDefs:array of TPropertyDef;
+  Propertycnt,iType:integer;
+
+  function findProperty(ireqdispid:integer):integer;
+  var i:integer;
+  begin
+    for i:=0 to Propertycnt-1 do
+      if aPropertyDefs[i].idispid=ireqdispid then
+        begin
+        result:=i;
+        exit;
+        end;
+    result:=Propertycnt;
+    Propertycnt:=Propertycnt+1;
+    with aPropertyDefs[result] do
+      begin
+      idispid:=ireqdispid;
+      bput:=false;
+      bget:=false;
+      name:='';
+      iptype:=vt_empty;
+      igtype:=vt_empty;
+      sptype:='';
+      sorgname:='';
+      sdoc:='';
+      sParam:='';
+      sDefault:='';
+      end;
+  end;
+
+begin
+  Propertycnt:=0;
+  SetLength(aPropertyDefs,TA^.cFuncs+TA^.cVars);   // worst case, all functions getters or all setters
+  result:='TA^.cFuncs';
+  if not bIsDispatch then
+    begin
+    // find base class
+    if TA^.cImplTypes>0 then
+      begin
+      OleCheck(TI.GetRefTypeOfImplType(0,RTIT));
+      OleCheck(TI.GetRefTypeInfo(RTIT,TIref));
+      OleCheck(TIRef.GetDocumentation(DISPID_UNKNOWN, @BstrNameRef, nil, nil, nil));
+      s:=format(#13#10'// %s : %s'#13#10#13#10' %s = interface(%s)'#13#10,[iname,iDoc,iname,BstrNameRef]);
+      end
+    else // no base class
+      begin
+      s:=format(#13#10'// %s : %s'#13#10#13#10' %s = interface'#13#10,[iname,iDoc,iname]);
+      end;
+    end
+  else
+    if (TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL then
+      s:=format(#13#10'// %s : %s'#13#10#13#10' %sDisp = dispinterface'#13#10,[iname,iDoc,iname])
+    else
+      s:=format(#13#10'// %s : %s'#13#10#13#10' %s = dispinterface'#13#10,[iname,iDoc,iname]);
+  sPropIntfc:='';
+  sPropDispIntfc:='';
+  s:=s+format('   [''%s'']'#13#10,[GUIDToString(TA^.GUID)]);
+  for j:=0 to TA^.cFuncs-1 do
+    begin
+    OleCheck(TI.GetFuncDesc(j,FD));
+    OleCheck(TI.GetNames(FD^.memid,@BL,length(BL),cnt));
+    // skip IUnknown and IDispatch methods
+    sl:=lowercase(BL[0]);
+    if (sl='queryinterface') or (sl='addref') or (sl='release') then  //IUnknown
+      continue;
+    if bIsDispatch and
+      ((sl='gettypeinfocount') or (sl='gettypeinfo') or (sl='getidsofnames') or (sl='invoke')) then  //IDispatch
+      continue;
+    // get return type
+    if bIsDispatch and ((FD^.invkind=INVOKE_PROPERTYGET) or (FD^.invkind=INVOKE_FUNC)) then
+      begin
+      sType:=TypeToString(TI,FD^.elemdescFunc.tdesc);
+      iType:=FD^.elemdescFunc.tdesc.vt;
+      end
+    else
+      if FD^.cParams>0 then
+        begin
+        sType:=TypeToString(TI,FD^.lprgelemdescParam[FD^.cParams-1].tdesc);
+        iType:=FD^.lprgelemdescParam[FD^.cParams-1].tdesc.vt;
+        if ((FD^.lprgelemdescParam[FD^.cParams-1].paramdesc.wParamFlags and (PARAMFLAG_FRETVAL or PARAMFLAG_FOUT)) <>0) then
+          begin
+          delete(sType,1,1); //out parameters are always defined as pointer
+          if assigned(FD^.lprgelemdescParam[FD^.cParams-1].tdesc.lptdesc) then
+            iType:=FD^.lprgelemdescParam[FD^.cParams-1].tdesc.lptdesc^.vt;
+          end;
+        end;
+    //get calling convention
+    if FD^.callconv=CC_STDCALL then
+      begin
+      if lowercase(BstrNameRef)='iunknown' then
+        sConv:='stdcall'
+      else
+        sConv:='safecall';
+      end
+    else
+      sConv:='cdecl';
+    // get info
+    OleCheck(TI.GetDocumentation(FD^.memid, @BstrName, @BstrDocString, nil, nil));
+    case FD^.invkind of
+      // build function/procedure
+      INVOKE_FUNC :
+        begin
+        if ValidateID(BstrName) then
+          sMethodName:=BstrName
+        else
+          begin
+          sMethodName:=BstrName+'_';
+          AddToHeader('//  Warning: renamed method ''%s'' in %s to ''%s''',[BstrName,iname,sMethodName],True);
+          end;
+        bIsFunction:=(bIsDispatch and (FD^.elemdescFunc.tdesc.vt<>VT_VOID)) or
+          (not bIsDispatch and (FD^.cParams>0) and ((FD^.lprgelemdescParam[FD^.cParams-1].paramdesc.wParamFlags and PARAMFLAG_FRETVAL ) <>0));
+        if bIsFunction then
+          sFunc:=format('    // %s : %s '#13#10'   function %s(',[sMethodName,BstrDocString,sMethodName])
+        else
+          sFunc:=format('    // %s : %s '#13#10'   procedure %s(',[sMethodName,BstrDocString,sMethodName]);
+        if bIsFunction and bIsDispatch and not bIsAutomatable then
+          begin
+          AddToHeader('//  Warning: ''%s'' not automatable in %sdisp.%s',[stype,iname,BstrName],True);
+          sType:='{!! '+sType+' !!} OleVariant';
+          end;
+        // parameters
+        for k:=0 to FD^.cParams-1 do
+          begin
+          if (FD^.lprgelemdescParam[k].paramdesc.wParamFlags and PARAMFLAG_FRETVAL ) <>0 then  //return type
+            continue;
+          sl:=TypeToString(TI,FD^.lprgelemdescParam[k].tdesc);
+          if sMethodName='Clone' then
+            sl:=sl;
+          if (FD^.lprgelemdescParam[k].tdesc.vt=VT_PTR) and                                        // by ref
+            not((FD^.lprgelemdescParam[k].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface) then // but not pointer to interface
+             delete(sl,1,1);
+          if bIsDispatch and not bIsAutomatable then
+            begin
+            AddToHeader('//  Warning: ''%s'' not automatable in %sdisp.%s',[sl,iname,sMethodName],True);
+            sl:='{!! '+sl+' !!} OleVariant';
+            end;
+          if (FD^.lprgelemdescParam[k].tdesc.vt=VT_PTR) and                                          // by ref
+              not((FD^.lprgelemdescParam[k].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface) then // but not pointer to interface
+            case FD^.lprgelemdescParam[k].paramdesc.wParamFlags and (PARAMFLAG_FIN or PARAMFLAG_FOUT) of
+            PARAMFLAG_FIN or PARAMFLAG_FOUT:sFunc:=sFunc+'var ';
+            PARAMFLAG_FOUT:sFunc:=sFunc+'out ';
+            PARAMFLAG_FIN:sFunc:=sFunc+'var '; //constref in safecall? TBD
+            end;
+          if ValidateID(BL[k+1]) then
+            sVarName:=BL[k+1]
+          else
+            begin
+            sVarName:=BL[k+1]+'_';
+            AddToHeader('//  Warning: renamed parameter ''%s'' in %s.%s to ''%s'''#13#10,[BL[k+1],iname,sMethodName,sVarName],True);
+            end;
+          sFunc:=sFunc+format('%s:%s;',[sVarName,sl]);
+          end;
+        // finish interface and dispinterface
+        if sFunc[length(sFunc)]=';' then
+          sFunc[length(sFunc)]:=')'
+        else  // no params
+          delete(sFunc,length(sFunc),1);
+        if bIsFunction then
+          sFunc:=sFunc+format(':%s',[sType]);
+        if bIsDispatch then
+          s:=s+sFunc+format(';dispid %d;'#13#10,[FD^.memid])
+        else
+          s:=s+sFunc+format(';%s;'#13#10,[sConv]);
+        end;
+      INVOKE_PROPERTYGET,INVOKE_PROPERTYPUT,INVOKE_PROPERTYPUTREF :
+        // build properties. Use separate string to group properties at end of interface declaration.
+        begin
+        if ValidateID(BstrName) then
+          sMethodName:=BstrName
+        else
+          begin
+          sMethodName:=BstrName+'_';
+          AddToHeader('//  Warning: renamed property ''%s'' in %s to ''%s''',[BstrName,iname,sMethodName]);
+          end;
+        bPropHasParam:=(((FD^.invkind=INVOKE_PROPERTYGET) and (FD^.cParams>0)) or (FD^.cParams>1))
+            and ((FD^.lprgelemdescParam[0].paramdesc.wParamFlags and PARAMFLAG_FIN) = PARAMFLAG_FIN) ;
+        if (FD^.memid=0) and  bPropHasParam then sl:=' default;' else sl:='';
+        sPropParam:='';
+        sPropParam2:='';
+        if bPropHasParam then
+          begin
+          sPropParam:=BL[1]+':'+TypeToString(TI,FD^.lprgelemdescParam[0].tdesc);
+          end;
+        if bIsDispatch then
+          begin
+          if (TD.vt<>VT_VOID) and not bIsAutomatable then
+            begin
+            AddToHeader('//  Warning: ''%s'' not automatable in %s.%s',[stype,iname,BstrName]);
+            sType:='{!! '+sType+' !!} OleVariant';
+            end;
+          if bPropHasParam then
+            sPropParam:='['+sPropParam+']';
+          i:=pos(format('dispid %d;',[FD^.memid]),sPropDispIntfc);
+          if i<=0 then
+            begin
+            if FD^.invkind=INVOKE_PROPERTYGET then
+              sType:=sType+' readonly '
+            else
+              sType:=sType+' writeonly';
+            sPropDispIntfc:=sPropDispIntfc+format('    // %s : %s '#13#10'   property %s%s:%s dispid %d;%s'#13#10,
+              [BstrName,BstrDocString,sMethodName,sPropParam,sType,FD^.memid,sl]);
+            end
+          else //remove readonly or writeonly
+            delete(sPropDispIntfc,i-11,10);   //10= length(' readonly ')
+          end
+        else
+          begin
+          //getters/setters for interface, insert in interface as they come,
+          //store in aPropertyDefs to create properties at the end
+          if bPropHasParam then
+            begin
+            sPropParam2:='('+sPropParam+')';
+            sPropParam:='['+sPropParam+']';
+            end;
+          if FD^.invkind=INVOKE_PROPERTYGET then
+            begin
+            s:=s+format('   function Get_%s%s : %s; %s;'#13#10,[sMethodName,sPropParam2,sType,sConv]);
+            with aPropertyDefs[findProperty(FD^.memid)] do
+              begin
+              bget:=true;
+              name:=sMethodName;
+              igtype:=itype;
+              sptype:=sType;
+              sorgname:=BstrName;
+              sdoc:=BstrDocString;
+              sParam:=sPropParam;
+              sDefault:=sl;
+              end;
+            end
+          else
+            begin
+            if ValidateID(BL[1]) then
+              sVarName:=BL[1]
+            else
+              begin
+              sVarName:=BL[1]+'_';
+              AddToHeader('//  Warning: renamed parameter ''%s'' in %s.Set_%s to ''%s''',[BL[1],iname,sMethodName,sVarName]);
+              end;
+            s:=s+format('   procedure Set_%s(const %s:%s); %s;'#13#10,[sMethodName,sVarName,sType,sConv]);
+            with aPropertyDefs[findProperty(FD^.memid)] do
+              begin
+              bput:=true;
+              name:=sMethodName;
+              iptype:=itype;
+              sptype:=sType;
+              sorgname:=BstrName;
+              sdoc:=BstrDocString;
+              sParam:=sPropParam;
+              sDefault:=sl;
+              end;
+            end;
+          end;
+        end;
+    end;
+    TI.ReleaseFuncDesc(FD);
+    end;
+  for j:=0 to TA^.cVars-1 do
+    begin  //read-write properties only
+    if bIsDispatch then
+      begin
+      TI.GetVarDesc(j,VD);
+      if assigned(VD) then
+        begin
+        TI.GetDocumentation(VD^.memId,@BstrName, @BstrDocString, nil, nil);
+        if ValidateID(BstrName) then
+          sMethodName:=BstrName
+        else
+          begin
+          sMethodName:=BstrName+'_';
+          AddToHeader('//  Warning: renamed property ''%s'' in %s to ''%s'''#13#10,[BstrName,iname,sMethodName]);
+          end;
+        sType:=TypeToString(TI,VD^.ElemdescVar.tdesc);
+        sPropDispIntfc:=sPropDispIntfc+format('    // %s : %s '#13#10'   property %s:%s  dispid %d;'#13#10,
+          [BstrName,BstrDocString,sMethodName,sType,VD^.memId]);
+        end;
+      end;
+    end;
+  if bIsDispatch then
+    result:=s + sPropDispIntfc +'  end;'#13#10
+  else
+    begin
+    // add interface properties
+    for i:=0 to Propertycnt-1 do
+      with aPropertyDefs[i] do
+      if (iptype=igtype) or not bget or not bput then
+        begin
+        s:=s+format('    // %s : %s '#13#10'   property %s%s:%s',[sorgname,sdoc,name,sParam,sptype]);
+        if bget then
+          s:=s+format(' read Get_%s',[name]);
+        if bput then
+          s:=s+format(' write Set_%s',[name]);
+        s:=s+format(';%s'#13#10,[sDefault]);
+        end;
+    result:=s+'  end;'#13#10;
+    end;
+end;
+
+function TTypeLibImporter.GetDependencies: TStrings;
+begin
+  Result:=FDependencies;
+end;
+
+function TTypeLibImporter.GetUnitSource: TStrings;
+begin
+  Result:=FUnitSource;
+end;
+
+Procedure TTypeLibImporter.ImportGUIDs(Const TL : ITypeLib; TICount : Integer);
+
+Var
+  i : integer;
+  BstrName, BstrDocString, BstrHelpFile : WideString;
+  dwHelpContext: DWORD;
+  TI:ITypeInfo;
+  TA:LPTYPEATTR;
+  TIT: TYPEKIND;
+
+begin
+  //GUIDs
+  for i:=0 to TIcount-1 do
+    begin
+    OleCheck(TL.GetTypeInfoType(i, TIT));
+    OleCheck(TL.GetTypeInfo(i, TI));
+    OleCheck(TL.GetDocumentation(i, @BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile));
+    OleCheck(TI.GetTypeAttr(TA));
+    case TIT of
+      TKIND_DISPATCH,TKIND_INTERFACE:
+        begin
+        AddToInterface('  IID_%s : TGUID = ''%s'';',[BstrName,GUIDToString(TA^.GUID)]);
+        end;
+      TKIND_COCLASS:
+        begin
+        AddToInterface('  CLASS_%s : TGUID = ''%s'';',[BstrName,GUIDToString(TA^.GUID)]);
+        end;
+      end;
+    TI.ReleaseTypeAttr(TA);
+    end;
+end;
+
+Procedure TTypeLibImporter.ImportEnums(Const TL : ITypeLib; TICount : Integer);
+
+Var
+  i,j : integer;
+  sl : string;
+  BstrName, BstrDocString, BstrHelpFile : WideString;
+  dwHelpContext: DWORD;
+  TI:ITypeInfo;
+  TA:LPTYPEATTR;
+  TIT: TYPEKIND;
+  bDuplicate:boolean;
+  VD: lpVARDESC;
+
+begin
+  //enums
+  AddToInterface('');
+  AddToInterface('//Enums');
+  AddToInterface('');
+  for i:=0 to TIcount-1 do
+    begin
+    OleCheck(TL.GetTypeInfoType(i, TIT));
+    OleCheck(TL.GetTypeInfo(i, TI));
+    OleCheck(TL.GetDocumentation(i, @BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile));
+    OleCheck(TI.GetTypeAttr(TA));
+    if TIT=TKIND_ENUM then
+      begin
+      bDuplicate:=false;
+      sl:=BstrName;
+      if (InterfaceSection.IndexOf(Format('  %s =TOleEnum;',[sl]))<>-1) then  // duplicate enums fe. AXVCL.dll 1.0
+        begin
+        sl:=sl+IntToStr(i); // index is unique in this typelib
+        AddToHeader('//  Warning: duplicate enum ''%s''. Renamed to ''%s''. consts appended with %d',[BstrName,sl,i]);
+        bDuplicate:=true;
+        end;
+      AddToInterface('Type');
+      AddToInterface('  %s =TOleEnum;',[sl]);
+      AddToInterface('Const');
+      for j:=0 to TA^.cVars-1 do
+        begin
+        TI.GetVarDesc(j,VD);
+        if assigned(VD) then
+          begin
+          TI.GetDocumentation(VD^.memId,@BstrName, nil, nil, nil);
+          sl:=BstrName;
+          if bDuplicate then
+            sl:=sl+IntToStr(i);
+          if assigned(VD^.lpvarValue) then
+            AddToInterface('  %s = $%s;',[sl,IntToHex(PtrInt(VD^.lpvarValue^),16)]);
+          end;
+        end;
+      end;
+    TI.ReleaseTypeAttr(TA);
+    end;
+end;
+
+Procedure TTypeLibImporter.CreateForwards(Const TL : ITypeLib; TICount : Integer);
+
+Var
+  i : integer;
+  BstrName, BstrDocString, BstrHelpFile : WideString;
+  dwHelpContext: DWORD;
+  TI:ITypeInfo;
+  TA:LPTYPEATTR;
+  TIT: TYPEKIND;
+
+begin
+  // Forward declarations
+  AddToInterface('//Forward declarations');
+  AddToInterface('');
+  AddToInterface('Type');
+  for i:=0 to TIcount-1 do
+    begin
+    OleCheck(TL.GetTypeInfoType(i, TIT));
+    OleCheck(TL.GetTypeInfo(i, TI));
+    OleCheck(TL.GetDocumentation(i, @BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile));
+    OleCheck(TI.GetTypeAttr(TA));
+    if (TIT=TKIND_DISPATCH) then
+      begin
+      if (TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL then
+        begin
+        AddToInterface(' %s = interface;',[BstrName]);
+        AddToInterFace(' %sDisp = dispinterface;',[BstrName]);
+        end
+      else
+        AddToInterface(' %s = dispinterface;',[BstrName]);
+      end
+    else if (TIT=TKIND_INTERFACE) then
+      AddToInterface(' %s = interface;',[BstrName]);
+    TI.ReleaseTypeAttr(TA);
+    end;
+end;
+
+Procedure TTypeLibImporter.CreateRecordsUnionsAliases(Const TL : ITypeLib; TICount : Integer);
+
+Var
+  i,j : integer;
+  BstrName, BstrDocString, BstrHelpFile : WideString;
+  dwHelpContext: DWORD;
+  TI:ITypeInfo;
+  TA:LPTYPEATTR;
+  TIT: TYPEKIND;
+  VD: lpVARDESC;
+
+begin
+  //records, unions aliases
+  AddToInterface('');
+  AddToInterface('//records, unions, aliases');
+  AddToInterface('');
+
+  for i:=0 to TIcount-1 do
+    begin
+    OleCheck(TL.GetTypeInfoType(i, TIT));
+    //s:=s+format('type %d'#13#10,[ord(TIT)]);
+    OleCheck(TL.GetTypeInfo(i, TI));
+    OleCheck(TL.GetDocumentation(i, @BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile));
+    OleCheck(TI.GetTypeAttr(TA));
+    case TIT of
+      TKIND_RECORD:
+        begin
+        AddToInterface(' P%s = ^%s;',[BstrName,BstrName]);
+        AddToInterface(' %s = packed record',[BstrName]);
+        for j:=0 to TA^.cVars-1 do
+          begin
+          TI.GetVarDesc(j,VD);
+          TI.GetDocumentation(VD^.memId,@BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile);
+          AddToInterface('     %s : %s;',[BstrName,TypeToString(TI, VD^.ElemdescVar.tdesc)]);
+          end;
+        AddToInterface(' end;');
+        end;
+      TKIND_ALIAS:
+        begin
+        AddToInterface('     %s = %s;',[BstrName,TypeToString(TI, TA^.tdescAlias)]);
+        end;
+      TKIND_UNION:
+        begin
+        end;
+      end;
+    TI.ReleaseTypeAttr(TA);
+    end;
+end;
+
+Procedure TTypeLibImporter.CreateInterfaces(Const TL : ITypeLib; TICount : Integer);
+
+Var
+  i : integer;
+  BstrName, BstrDocString, BstrHelpFile : WideString;
+  dwHelpContext : DWORD;
+  TI,TIref : ITypeInfo;
+  TA,TAref : LPTYPEATTR;
+  TIT : TYPEKIND;
+  RTIT : HREFTYPE;
+
+begin
+  // interface declarations
+  AddToInterface('//interface declarations');
+  for i:=0 to TIcount-1 do
+    begin
+    OleCheck(TL.GetTypeInfoType(i, TIT));
+    OleCheck(TL.GetTypeInfo(i, TI));
+    OleCheck(TL.GetDocumentation(i, @BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile));
+    if (TIT=TKIND_DISPATCH) or (TIT=TKIND_INTERFACE) then
+      begin
+      OleCheck(TI.GetTypeAttr(TA));
+      if (TIT=TKIND_DISPATCH) then
+        begin
+        // get also TKIND_INTERFACE if dual interface
+        if (TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL then
+          begin
+          OleCheck(TI.GetRefTypeOfImplType(-1,RTIT));
+          OleCheck(TI.GetRefTypeInfo(RTIT,TIref));
+          OleCheck(TIref.GetTypeAttr(TAref));
+          AddToInterface(interfacedeclaration(BstrName,BstrDocString,TIref,TAref,false));
+          TIref.ReleaseTypeAttr(TAref);
+          end;
+        AddToInterface(interfacedeclaration(BstrName,BstrDocString,TI,TA,true));
+        end
+      else
+        AddToInterface(interfacedeclaration(BstrName,BstrDocString,TI,TA,false));
+      TI.ReleaseTypeAttr(TA);
+      end;
+    end;
+end;
+
+Procedure TTypeLibImporter.CreateCoClasses(Const TL : ITypeLib; TICount : Integer);
+
+Var
+  i : integer;
+  BstrName, BstrDocString, BstrHelpFile, BstrNameRef : WideString;
+  dwHelpContext : DWORD;
+  TI,TIref : ITypeInfo;
+  TA : LPTYPEATTR;
+  TIT : TYPEKIND;
+  RTIT : HREFTYPE;
+
+begin
+  //CoClasses
+  AddToInterface('//CoClasses');
+  AddToImplementation('implementation');
+  AddToImplementation('');
+  AddToImplementation('uses comobj;');
+  AddToImplementation('');
+  for i:=0 to TIcount-1 do
+    begin
+    OleCheck(TL.GetTypeInfoType(i, TIT));
+    if TIT =TKIND_COCLASS then
+      begin
+      OleCheck(TL.GetTypeInfo(i, TI));
+      OleCheck(TL.GetDocumentation(i, @BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile));
+      OleCheck(TI.GetTypeAttr(TA));
+      OleCheck(TI.GetRefTypeOfImplType(0,RTIT));
+      OleCheck(TI.GetRefTypeInfo(RTIT,TIref));
+      OleCheck(TIRef.GetDocumentation(DISPID_UNKNOWN, @BstrNameRef, nil, nil, nil));
+      AddToInterFace('  Co%s = Class',[BstrName]);
+      AddToInterface('    Class Function Create: %s;',[BstrNameRef]);
+      AddToInterFace('    Class Function CreateRemote(const MachineName: string): %s;',[BstrNameRef]);
+      AddToInterFace('  end;');
+      AddToInterFace('');
+      AddToImplementation('Class Function Co%s.Create: %s;',[BstrName,BstrNameRef]);
+      AddToImplementation('begin');
+      AddToImplementation('  Result := CreateComObject(CLASS_%s) as %s;',[BstrName,BstrNameRef]);
+      AddToImplementation('end;');
+      AddToImplementation('');
+      AddToImplementation('Class Function Co%s.CreateRemote(const MachineName: string): %s;',[BstrName,BstrNameRef]);
+      AddToImplementation('begin');
+      AddToImplementation('  Result := CreateRemoteComObject(MachineName,CLASS_%s) as %s;',[BstrName,BstrNameRef]);
+      AddToImplementation('end;');
+      AddToImplementation('');
+      TI.ReleaseTypeAttr(TA);
+      end;
+    end;
+end;
+
+Procedure TTypeLibImporter.CreateUnitHeader(Const TL : ITypeLib; const LA: lpTLIBATTR);
+
+
+Var
+  BstrName, BstrDocString, BstrHelpFile : WideString;
+  dwHelpContext: DWORD;
+
+begin
+  OleCheck(TL.GetDocumentation(-1, @BstrName, @BstrDocString, @dwHelpContext, @BstrHelpFile));
+  if (UnitName='') then
+    if FAppendVersionNumber then
+      UnitName:=format('%s_%d_%d_TLB',[BstrName,LA^.wMajorVerNum,LA^.wMinorVerNum])
+    else
+      UnitName:=format('%s_TLB',[BstrName]);
+  //header
+  AddToHeader('Unit %s;',[UnitName],True);
+  AddToHeader('',true);
+  AddToHeader('//  Imported %s on %s from %s',[BstrName,DateTimeToStr(Now()),InputFilename],True);
+  AddToHeader('',true);
+  AddToHeader('{$mode delphi}{$H+}',true);
+  AddToHeader('',true);
+  AddToHeader('interface',true);
+  AddToHeader('',true);
+  FUses.Add('Windows');
+  FUses.Add('ActiveX');
+  FUses.Add('Classes');
+  FUses.Add('OleServer');
+  FUses.Add('Variants');
+  AddToInterface('Const');
+  AddToInterface('  %sMajorVersion = %d;',[BstrName,LA^.wMajorVerNum]);
+  AddToInterface('  %sMinorVersion = %d;',[BstrName,LA^.wMinorVerNum]);
+  AddToInterface('  %sLCID = %x;',[BstrName,LA^.LCID]);
+  AddToInterface('  LIBID_%s : TGUID = ''%s'';',[BstrName,GUIDToString(LA^.GUID)]);
+  AddToInterface('');
+end;
+
+Procedure TTypeLibImporter.DoImportTypelib;
+
+var
+  TL: ITypelib;
+  TIcount:integer;
+  LA: lpTLIBATTR;
+
+begin
+  Header.Clear;
+  InterfaceSection.Clear;
+  OleCheck(LoadTypeLib(PWidechar(InputFileName), TL ));
+  OleCheck(TL.GetLibAttr(LA));
+  try
+    CreateUnitHeader(TL,LA);
+    TIcount:=TL.GetTypeInfoCount;
+    ImportGUIDs(TL,TICount);
+    ImportEnums(TL,TICount);
+    CreateForwards(TL,TICount);
+    CreateRecordsUnionsAliases(TL,TICount);
+    CreateInterFaces(TL,TICount);
+    CreateCoClasses(TL,TICount);
+  finally
+    TL.ReleaseTLibAttr(LA);
+  end;
+  BuildUnit;
+end;
+
+procedure TTypeLibImporter.BuildUnit;
+
+Var
+  l : string;
+  I : Integer;
+
+begin
+  UnitSource.AddStrings(Header);
+  UnitSource.Add('Uses');
+  L:='  ';
+  For I:=0 to FUses.Count-1 do
+    begin
+    L:=L+FUses[i];
+    If (I<Fuses.Count-1) then
+      L:=L+','
+    else
+      L:=L+';';
+    if (Length(L)>72) then
+      begin
+      UnitSource.Add(L);
+      L:='  ';
+      end;
+    end;
+  if (L<>'  ') then
+    UnitSource.Add(L);
+  UnitSource.addStrings(InterfaceSection);
+  UnitSource.addStrings(ImplementationSection);
+  UnitSource.Add('end.');
+end;
+
+{ TTypeLibImporter }
+
+procedure TTypeLibImporter.SetOutputFileName(AValue: String);
+
+Var
+  UN : String;
+
+begin
+  if FOutputFileName=AValue then Exit;
+  UN:=ChangeFileExt(ExtractFileName(AValue),'');
+  if not IsValidIdent(UN) then
+    Raise Exception.CreateFmt(SErrInvalidUnitName,[UN]);
+  FOutputFileName:=AValue;
+  SetUnitName(UN)
+end;
+
+procedure TTypeLibImporter.SetUnitName(AValue: string);
+begin
+  if FUnitname=AValue then Exit;
+  if not IsValidIdent(AVAlue) then
+    Raise Exception.CreateFmt(SErrInvalidUnitName,[AValue]);
+  FUnitname:=AValue;
+  if (OutputFileName<>'') then
+    OutputFileName:=ExtractFilePath(OutputFileName)+UnitName+'.pas';
+end;
+
+procedure TTypeLibImporter.AddToUses(const AUnit: String);
+begin
+  If FUses.IndexOf(AUnit)=-1 then
+    FUses.add(AUnit);
+end;
+
+procedure TTypeLibImporter.AddToHeader(const ALine: String;
+  AllowDuplicate: Boolean);
+
+begin
+  If (AllowDuplicate) or (FHeader.IndexOf(ALine)=-1) then
+    FHeader.Add(ALine);
+end;
+
+procedure TTypeLibImporter.AddToHeader(const Fmt: String; Args: array of const;
+  AllowDuplicate: Boolean);
+begin
+  AddToheader(Format(Fmt,Args),AllowDuplicate)
+end;
+
+procedure TTypeLibImporter.AddToInterface(const ALine: String);
+begin
+  FInterface.Add(ALine);
+end;
+
+procedure TTypeLibImporter.AddToInterface(const Fmt: String;
+  Args: array of const);
+begin
+  FInterface.Add(Format(Fmt,Args));
+end;
+
+procedure TTypeLibImporter.AddToImplementation(const ALine: String);
+begin
+  FImplementation.Add(ALine);
+end;
+
+procedure TTypeLibImporter.AddToImplementation(const Fmt: String;
+  Args: array of const);
+begin
+  FImplementation.Add(Format(Fmt,Args));
+end;
+
+constructor TTypeLibImporter.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDependencies:=TStringList.Create;
+  FUnitSource:=TStringList.Create;
+  FAppendVersionNumber:=true;
+end;
+
+destructor TTypeLibImporter.Destroy;
+begin
+  FreeAndNil(FDependencies);
+  FreeAndNil(FUnitSource);
+  inherited Destroy;
+end;
+
+procedure TTypeLibImporter.Execute;
+begin
+  FDependencies.Clear;
+  FUnitSource.Clear;
+  FHeader:=TStringList.Create;
+  FInterface:=TStringList.Create;
+  FImplementation:=TStringList.Create;
+  FUses:=TStringList.Create;
+  try
+    DoImportTypeLib;
+    If (OutputFileName<>'') then
+      UnitSource.SaveToFile(OutputFileName);
+  finally
+    FreeAndNil(FUses);
+    FreeAndNil(FInterface);
+    FreeAndNil(FHeader);
+    FreeAndNil(FImplementation);
+  end;
+end;
+
+end.
+