Software creation of a type library

The TLB type library can store information about the capabilities of COM components: classes, interfaces, methods, parameter types, and return values. In practical programming guides, COM components usually tell you how to create a type library manually using the midl.exe midl.exe , but today we will look at how to do this programmatically through the ICreateTypeLib2 and ICreateTypeInfo2 .

FreeBASIC will be the “programming language”.

Interfaces

In fribysika, there is no Interface keyword for declaring interfaces, but we will cope with this task with our bare hands. To demonstrate the seriousness of intentions, we will build a natural fraction interface and look at all the stages of building interfaces from scratch.

Simplify the concept of the interface to a set of functions that should be implemented.

Interface as a data type

Define the class of natural fraction. Such a class must have properties that specify the numerator and denominator, and we will also add the addition of fractions there. Since we will later need to have access from the inherited object to the implemented functions, this means that such a set should consist of pointers to our future functions. Wrap them in the structure:

 Type IRational Dim GetNumerator As Function()As Integer Dim SetNumerator As Sub(ByVal Numerator As Integer) Dim GetDenominator As Function()As Integer Dim SetDenominator As Sub(ByVal Denominator As Integer) Dim AddRational As Sub(ByVal pRational As IRational Ptr) End Type 

Add call context

So that the functions of the interface know which object calls them, we add the first parameter to the pointer to the object that implements our interface:

 Type IRational Dim GetNumerator As Function(ByVal this As IRational Ptr)As Integer Dim SetNumerator As Sub(ByVal this As IRational Ptr, ByVal Numerator As Integer) Dim GetDenominator As Function(ByVal this As IRational Ptr)As Integer Dim SetDenominator As Sub(ByVal this As IRational Ptr, ByVal Denominator As Integer) Dim AddRational As Sub(ByVal this As IRational Ptr, ByVal pRational As IRational Ptr) End Type 

Virtual method table

In practice, the set of interface functions is separated into a separate structure, which is now called a virtual method table, and in the interface itself, a link to it is left. The name VirtualTable is often shortened to Vtable or even Vtbl:

 Type IRationalVirtualTable Dim GetNumerator As Function(ByVal this As IRational Ptr)As Integer Dim SetNumerator As Sub(ByVal this As IRational Ptr, ByVal Numerator As Integer) Dim GetDenominator As Function(ByVal this As IRational Ptr)As Integer Dim SetDenominator As Sub(ByVal this As IRational Ptr, ByVal Denominator As Integer) Dim AddRational As Sub(ByVal this As IRational Ptr, ByVal pRational As IRational Ptr) End Type Type IRational Dim lpVtbl As IRationalVirtualTable Ptr End Type 

Allow circular references

We are trying to compile everything, but for some reason the compiler resists such code. The fact is that the virtual table IRationalVirtualTable refers to the IRational interface declared later, and the IRational interface refers to the virtual table IRationalVirtualTable , and as they do not change places, they do not stop referencing each other. The additional name for our interface entered by the Type operator will help to get out of the situation, and add the underscore to the name of the original interface:

 Type IRational As IRational_ Type IRationalVirtualTable Dim GetNumerator As Function(ByVal this As IRational Ptr)As Integer Dim SetNumerator As Sub(ByVal this As IRational Ptr, ByVal Numerator As Integer) Dim GetDenominator As Function(ByVal this As IRational Ptr)As Integer Dim SetDenominator As Sub(ByVal this As IRational Ptr, ByVal Denominator As Integer) Dim AddRational As Sub(ByVal this As IRational Ptr, ByVal pRational As IRational Ptr) End Type Type IRational_ Dim lpVtbl As IRationalVirtualTable Ptr End Type 

Well, now, the definition of our interface is ready.

COM interfaces

All COM technology is built on interfaces. All COM interfaces are built according to the principle described above, but with additional restrictions:

• all COM interfaces are directly or indirectly inherited from the IUnknown interface;
• with the exception of the AddRef and Release methods, all procedures and functions must return the HRESULT data type;
• The “real” return value is entered by the function into the pointer passed to it by the last parameter.

In order for our interface to be manipulated not only through the virtual functions table, but also by function names from script programming languages, it is recommended to inherit interfaces not directly from IUnknown , but from IDispatch . Interfaces that support function calls through the table and IDispatch simultaneously are called dual. We also change the type of the operands of the functions from Integer to Long to match the types of automation.

GUID

Each interface and implementing class must have unique identifiers. To do this, use 128-bit numbers calculated by a special algorithm that guarantees uniqueness. Such numbers are called GUID . In the header file, the GUID defined as a structure of the same name with the additional names IID (interface identifier) ​​and CLSID (class identifier). You can get the GUID through the guidgen.exe utility or through the CoCreateGuid function. The GUID program for interfaces and classes are written as follows:

 '   IRational ' {4116B36A-0B0D-48FD-8DB6-B9867F2A1A37} Dim Shared IID_IRational As IID = Type(&h4116b36a, &hb0d, &h48fd, _ {&h8d, &hb6, &hb9, &h86, &h7f, &h2a, &h1a, &h37}) '   Rational,  IRational ' {DD6C5B70-592D-41C1-A391-BCB8C7F7639A} Dim Shared CLSID_Rational As CLSID = Type(&hdd6c5b70, &h592d, &h41c1, _ {&ha3, &h91, &hbc, &hb8, &hc7, &hf7, &h63, &h9a}) 

Conversion of the IRational interface to COM-compatible

We will change our interface in accordance with these requirements by adding header files and guards from re-enabling the code. Here is the final IRational.bi header file:

 #ifndef IRATIONAL_BI #define IRATIONAL_BI #ifndef unicode #define unicode #endif #include once "windows.bi" #include once "win\ole2.bi" ' {4116B36A-0B0D-48FD-8DB6-B9867F2A1A37} Dim Shared IID_IRational As IID = Type(&h4116b36a, &hb0d, &h48fd, _ {&h8d, &hb6, &hb9, &h86, &h7f, &h2a, &h1a, &h37}) ' {DD6C5B70-592D-41C1-A391-BCB8C7F7639A} Const CLSIDS_Rational = "{DD6C5B70-592D-41C1-A391-BCB8C7F7639A}" Dim Shared CLSID_Rational As CLSID = Type(&hdd6c5b70, &h592d, &h41c1, _ {&ha3, &h91, &hbc, &hb8, &hc7, &hf7, &h63, &h9a}) Type IRational As IRational_ Type IRationalVirtualTable '   IDispatch Dim VirtualTable As IDispatchVtbl Dim GetNumerator As Function(ByVal this As IRational Ptr, ByVal pResult As Long Ptr)As HRESULT Dim SetNumerator As Function(ByVal this As IRational Ptr, ByVal Numerator As Long)As HRESULT Dim GetDenominator As Function(ByVal this As IRational Ptr, ByVal pResult As Long Ptr)As HRESULT Dim SetDenominator As Function(ByVal this As IRational Ptr, ByVal Denominator As Long)As HRESULT Dim AddRational As Function(ByVal this As IRational Ptr, ByVal pRational As IRational Ptr)As HRESULT End Type Type IRational_ Dim lpVtbl As IRationalVirtualTable Ptr End Type #endif 

Type library

Our type library will consist of the definition of an IRational interface and the Rational class that implements it.

Preparatory stage

For the COM environment to work, it must be initialized by calling CoInitialize(0) . When it is no longer needed, call the appropriate CoUnInitialize() .

Define the ID of the future library:

 ' {23F94DA0-5C11-46C1-9F27-6A3FE27985CF} Dim Shared LIBID_Rational As GUID = Type(&h23f94da0, &h5c11, &h46c1, _ {&h9f, &h27, &h6a, &h3f, &he2, &h79, &h85, &hcf}) 

Since IRational inherited from IDispatch , we need to load the stdole32.tlb library, where ITypeInfo from IDispatch is stored, in order to add a link to it:

 CoInitialize(0) Dim pIDispatchTypeInfo As ITypeInfo Ptr = Any Dim pStdOleTypeLib As ITypeLib Ptr = Any LoadTypeLib("stdole32.tlb", @pStdOleTypeLib) pStdOleTypeLib->lpVtbl->GetTypeInfoOfGuid(pStdOleTypeLib, @IID_IDispatch, @pIDispatchTypeInfo) ' stdole32.tlb    pStdOleTypeLib->lpVtbl->Release(pStdOleTypeLib) 

Creating a library

You can get the ICreateTypeLib2 interface for creating a library using the CreateTypeLib2 function. It takes three parameters: the system type ( SYS_MAC , SYS_WIN16 , SYS_WIN32 or SYS_WIN64 ), the name of the library file, and a pointer to the interface.

 Dim pCreateTypeLib As ICreateTypeLib2 Ptr = Any CreateTypeLib2(SYS_WIN32, "Rational.tlb", @pCreateTypeLib) '   , GUID, ,    pCreateTypeLib->lpVtbl->SetName(pCreateTypeLib, "Rational") pCreateTypeLib->lpVtbl->SetGuid(pCreateTypeLib, @LIBID_Rational) pCreateTypeLib->lpVtbl->SetVersion(pCreateTypeLib, 1, 0) pCreateTypeLib->lpVtbl->SetLcid(pCreateTypeLib, 1049) '   pCreateTypeLib->lpVtbl->SetDocString(pCreateTypeLib, "  ") 

Adding the IRational Interface to the Library

CreateTypeInfo method allows you to add interfaces, classes, modules with functions, enumerations, structures, unions, and aliases to the library. To do this, it needs to pass one of the values ​​of the TYPEKIND enumeration.

We will consider adding only classes and interfaces. The return value is ICreateTypeInfo to configure the resulting entity.

 Dim pCreateTypeInfoIRational As ICreateTypeInfo Ptr = Any pCreateTypeLib->lpVtbl->CreateTypeInfo(pCreateTypeLib, @IRationalInterfaceName, TKIND_INTERFACE, @pCreateTypeInfoIRational) '  IID    pCreateTypeInfoIRational->lpVtbl->SetGuid(pCreateTypeInfoIRational, @IID_IRational) pCreateTypeInfoIRational->lpVtbl->SetDocString(pCreateTypeInfoIRational, @"    ") '       pCreateTypeInfoIRational->lpVtbl->SetTypeFlags(pCreateTypeInfoIRational, TYPEFLAG_FDUAL Or TYPEFLAG_FOLEAUTOMATION) 

For inheritance, you must create a link to the interface ‑ father. A small stick in the wheel: you have to independently monitor the indexes of added links to all fathers.

 '   IDispatch Dim RefType As HREFTYPE = Any hr = pCreateTypeInfoIRational->lpVtbl->AddRefTypeInfo(pCreateTypeInfoIRational, pIDispatchTypeInfo, @RefType) ' 0 —    hr = pCreateTypeInfoIRational->lpVtbl->AddImplType(pCreateTypeInfoIRational, 0, RefType) ' IDispatchTypeInfo    pIDispatchTypeInfo->lpVtbl->Release(pIDispatchTypeInfo) 

Adding features to the IRational interface

Functions have parameters and a return value. Functions are represented by the FUNCDESC structure, and parameters by an array of ELEMDESC structures. Since all interface functions return HRESULT , you can create a return value for all functions in advance:

 Dim HresultReturnedValue As ELEMDESC With HresultReturnedValue .tdesc.vt = VT_HRESULT .idldesc.wIDLFlags = IDLFLAG_NONE End With 

Here vt specifies one of the VARENUM enumeration VARENUM , and IDLFLAG_NONE indicates that no flags are assigned. Flags can take a combination of the following values:

In some cases, an object may have properties. From the side, the property looks like a variable, but from the inside it is provided with the help of set functions and return values. Functions can be described by one of the following values:

More functions are categorized by implementation:

GetNumerator function

In high-level programming languages, function call contexts (pointer to an object), as well as virtual function tables, are hidden from the programmer and are not taken into account in interfaces, therefore we will not specify them when setting parameters. We introduce the description of the parameters of the GetNumerator function:

 Const MaxArgumentGetNumeratorNamesLength As UINT = 2 Const MaxArgumentGetNumeratorLength As SHORT = 1 '       '      ,        Get. Dim GetNumeratorArgumentNames(MaxArgumentGetNumeratorNamesLength - 1) As WString Ptr = Any GetNumeratorArgumentNames(0) = @"Numerator" GetNumeratorArgumentNames(1) = @"pResult" '   — «»   Dim GetNumeratorArguments(MaxArgumentGetNumeratorLength - 1) As ELEMDESC Dim RetvalGetNumerator As TYPEDESC With RetvalGetNumerator .vt = VT_I4 '   Long End With With GetNumeratorArguments(0) .tdesc.vt = VT_PTR '  .tdesc.lptdesc = @RetvalGetNumerator '    .idldesc.wIDLFlags = IDLFLAG_FOUT Or IDLFLAG_FRETVAL End With 

Filling in the FUNCDESC structure for the GetNumerator function:

 Dim GetNumeratorDefinition As FUNCDESC = Any With GetNumeratorDefinition .memid = 0 '      IDispatch.Invoke,   ‐     .lprgscode = 0 '     HRESULT .cScodes = 0 '     .lprgelemdescParam = @GetNumeratorArguments(0) '      .cParams = MaxArgumentGetNumeratorLength '   .cParamsOpt = 0 '    .elemdescFunc = HresultReturnedValue '   HRESULT .funckind = FUNC_PUREVIRTUAL '    .invkind = INVOKE_PROPERTYGET '    .callconv = CC_STDCALL '    STDCALL .oVft = 0 '     ,    FUNC_VIRTUAL .wFuncFlags = 0 End With 

Now the function can be put on the interface. Here again you have to keep track of the index of the function being added, in our case it is 0:

 '    pCreateTypeInfoIRational->lpVtbl->AddFuncDesc(pCreateTypeInfoIRational, 0, @GetNumeratorDefinition) '     pCreateTypeInfoIRational->lpVtbl->SetFuncAndParamNames(pCreateTypeInfoIRational, 0, @GetNumeratorArgumentNames(0), MaxArgumentGetNumeratorNamesLength) '    pCreateTypeInfoIRational->lpVtbl->SetFuncDocString(pCreateTypeInfoIRational, 0, @" ") 

SetNumerator function

Similarly, we define the second part of the Numerator property:

 Const MaxArgumentSetNumeratorNamesLength As UINT = 2 Const MaxArgumentSetNumeratorLength As SHORT = 1 Dim SetNumeratorArgumentNames(MaxArgumentSetNumeratorNamesLength - 1) As WString Ptr = Any SetNumeratorArgumentNames(0) = @"Numerator" SetNumeratorArgumentNames(1) = @"Numerator" '     Dim SetNumeratorArguments(MaxArgumentSetNumeratorLength - 1) As ELEMDESC With SetNumeratorArguments(0) .tdesc.vt = VT_I4 ' Long .idldesc.wIDLFlags = IDLFLAG_FIN End With Dim SetNumeratorDefinition As FUNCDESC = Any With SetNumeratorDefinition .memid = 0 '       GetNumerator .lprgscode = 0 .cScodes = 0 .lprgelemdescParam = @SetNumeratorArguments(0) '    .cParams = MaxArgumentSetNumeratorLength '   .cParamsOpt = 0 .elemdescFunc = HresultReturnedValue .funckind = FUNC_PUREVIRTUAL .invkind = INVOKE_PROPERTYPUT '   .callconv = CC_STDCALL .oVft = 0 .wFuncFlags = 0 End With 

To add a function to the interface, you will again have to monitor the indexes manually. However, in the SetFuncAndParamNames method, SetFuncAndParamNames must specify the index of the previous GetNumerator function, since it is a pair for the property.

 pCreateTypeInfoIRational->lpVtbl->AddFuncDesc(pCreateTypeInfoIRational, 1, @SetNumeratorDefinition) '    0 —     pCreateTypeInfoIRational->lpVtbl->SetFuncAndParamNames(pCreateTypeInfoIRational, 0, @SetNumeratorArgumentNames(0), MaxArgumentSetNumeratorNamesLength) pCreateTypeInfoIRational->lpVtbl->SetFuncDocString(pCreateTypeInfoIRational, 1, @" ") 

Similarly, functions are added to return and set the denominator, with indices 2 and 3.

AddRational function

The AddRational function accepts a parameter of type pointer to IRational . But there is no such data type in automation, so we replace it with IDispatch :

 Const MaxArgumentAddRationalLength As SHORT = 1 Dim AddRationalArguments(MaxArgumentAddRationalLength - 1) As ELEMDESC Dim RetvalAddRational As TYPEDESC With RetvalAddRational .vt = VT_DISPATCH End With With AddRationalArguments(0) .tdesc.lptdesc = @RetvalAddRational .tdesc.vt = VT_PTR ' IDispatch Ptr .idldesc.wIDLFlags = IDLFLAG_FIN End With 

In the object browser, the parameter will be visible as Object , and its transmission will follow the link ByRef .

The definition of the AddRational function AddRational filled in the same way as the previous ones, it only remains to change the type of the function to INVOKE_FUNC , and when putting the function on the interface, specify the index by one more than the previous entity being added, in our case it is 4. You can create a separate variable for the indices and increase it after adding the new an item.

Closing the IRational Interface

We will IRational ITypeInfo interface from IRational so that our future Rational class can be inherited from it:

 Dim pIRationalTypeInfo As ITypeInfo Ptr = Any pCreateTypeInfoIRational->lpVtbl->QueryInterface(pCreateTypeInfoIRational, @IID_ITypeInfo, @pIRationalTypeInfo) 

After setting up the content of IRational it is necessary to seal all its contents and destroy:

 pCreateTypeInfoIRational->lpVtbl->LayOut(pCreateTypeInfoIRational) pCreateTypeInfoIRational->lpVtbl->Release(pCreateTypeInfoIRational) 

Adding a Rational class to a library

Adding classes is much faster than interfaces with functions, because here you only need to add to the interface class à dads:

 '   Dim pCreateTypeInfoRational As ICreateTypeInfo Ptr = Any pCreateTypeLib->lpVtbl->CreateTypeInfo(pCreateTypeLib, @"Rational", TKIND_COCLASS, @pCreateTypeInfoRational) '  GUID    pCreateTypeInfoRational->lpVtbl->SetGuid(pCreateTypeInfoRational, @CLSID_Rational) pCreateTypeInfoRational->lpVtbl->SetDocString(pCreateTypeInfoRational, @" ") '   IRational Dim RefType As HREFTYPE = Any pCreateTypeInfoRational->lpVtbl->AddRefTypeInfo(pCreateTypeInfoRational, pIRationalTypeInfo, @RefType) pCreateTypeInfoRational->lpVtbl->AddImplType(pCreateTypeInfoRational, 0, RefType) pIRationalTypeInfo->lpVtbl->Release(pIRationalTypeInfo) '      pCreateTypeInfoRational->lpVtbl->LayOut(pCreateTypeInfoRational) pCreateTypeInfoRational->lpVtbl->Release(pCreateTypeInfoRational) 

Saving Library

It's time to save the results to disk:

 pCreateTypeLib->lpVtbl->SaveAllChanges(pCreateTypeLib) pCreateTypeLib->lpVtbl->Release(pCreateTypeLib) CoUnInitialize() 

findings

This example shows that you can create type libraries programmatically without knowing the IDL interface definition language and the midl.exe compiler, despite the cumbersome code.

Using ICreateTypeLib2 and ICreateTypeInfo2 you can create not only the description of COM interfaces and classes, but also the usual functions from a DLL. This approach is used in Visual Basic 6 to bind to a DLL through an import table.

To simplify the code, error checking has been removed. In serious programs, you should always check the HRESULT return value and take action when something went wrong.