Next: Step 4 - Class Factory Implementation, Previous: Step 2 - Base package, Up: The COM object implementation [Contents][Index]

#### 5.1.3 Step 3 - Object Implementation

The process of creating the actual COM object begins with creating implementations of each method of every interface the object will be using. Even though a COM object may support multiple interfaces and it is not necessary, although certainly possible if needed, to repeat the implementations of methods shared by each interface. For example it is not necessary to define multiple instances of the `AddRef` method. Interfaces are views of the object, and not objects themselves.

Each method must conform to the same signature as the access functions they will be assigned to as they have been defined in the main package. All objects will include implementations for `IUnknown` and those that are dual interfaces, will also support `IDispatch`.

Records need to be created for each interface that will contain a table of addresses of each method implementation. For example:

    type IGNATStat_Vtbl_Record is
       record
          --  IUnknown
          QueryInterface   : Af_IUnknown_QueryInterface
            := IUnknown_QueryInterface'Access;
          AddRef           : Af_IUnknown_AddRef
            := IUnknown_AddRef'Access;
          Release          : Af_IUnknown_Release
            := IUnknown_Release'Access;

          --  IGNATMessage
          Calls             : Af_IGNATStat_Calls
            := IGNATStat_Calls'Access;
       end record;
    pragma Convention (C, IGNATStat_Vtbl_Record);
    type IGNATStat_Vtbl_Pointer is access all IGNATMessage_Vtbl_Record;

An instance of each record must be present in memory so that the interface can be passed to clients of the COM object. This is done by creating an aliased object of the record type.

    IGNATStat_Vtbl : aliased IGNATStat_Vtbl_Record;

A record representing the instance data for the object is also created and a function to create a new COM object with that data is also needed. This record also contains a reference count for the COM object. Every time any interface reference is adjusted the object’s reference count is also adjusted. When there are no interfaces in use the reference count will reach none and the instance data for the COM object can then be freed.

    --  Internal data for the COM object. Notice that there is
    --  no Convention pragma on this type. This type is an Ada type.

    type GNATCOMClass_Object is record
       Ref_Count : aliased Win32.LONG := 1;
       Data      : Controlled_Information;
       Count     : Integer := 0;
    end record;
    type GNATCOMClass_Pointer is access all GNATCOMClass_Object;

    function New_Object return Interface_Pointer;

The function that creates the COM object returns an access to the objects `IUnknown` interface to be used bye the objects class factory. Typically the function will be like this one:

    function New_Object return Interface_Pointer is
       New_Interface : aliased Interface_Pointer;
       New_Object    : aliased GNATCOMClass_Pointer;
    begin
       New_Interface := new Interface;
       New_Object    := new GNATCOMClass_Object;
       New_Interface.CoClass := New_Object.all'Address;
       New_Interface.Vtbl := IGNATMessage_Vtbl'Address;
       return New_Interface;
    end New_Object;

COM objects that will support dual interfaces will most likely want to take advantage of the Win32 APIs that implement `IDispatch` using the objects type library. In order for these APIs to function, they need access to the type library. A sound way of implementing this is using a controlled object that loads the type library when the object is created and frees it when the object is destroyed. For example:

    --  Controlled type for handling information that should be
    --  processed when the object is created or destroyed.

    type Controlled_Information is
      new Ada.Finalization.Controlled with record
          Type_Information : aliased Win32.OleAuto.LPTYPEINFO := null;
      end record;

    procedure Initialize (This : in out Controlled_Information);
    procedure Finalize (This : in out Controlled_Information);
    procedure Adjust (This : in out Controlled_Information);

The implementation of this example uses the Win32 API `LoadRegTypeLib` to load the type library interface and then uses Adjust and Finalize to handle the reference counting issues related to the interface. Implementation of the `IDispatch` methods then just call the appropriate Win32 APIs passing the type information interface contained in the controlled object.

Every object will need to implement the `IUnknown` functions. The `Addref` and `Release` methods will be the same for each object.

    ———————
    – IUnknown_AddRef –
    ———————

    function IUnknown_AddRef (This : access Interface)
      return Win32.ULONG
    is
       lResult : Win32.Long;
       Object  : GNATCOMClass_Pointer := To_Object_Pointer (This.CoClass);
    begin
       --  InterlockedIncrement is a thread protected Win32 API function
       --  to increment a long

       --  Interface reference increment
       lResult :=
         Win32.Winbase.InterlockedIncrement (This.Ref_Count'Access);

       --  Object reference increment
       lResult :=
         Win32.Winbase.InterlockedIncrement (Object.Ref_Count'Access);

       return Win32.ULONG (This.Ref_Count);

    end IUnknown_AddRef;

    ———————-
    – IUnknown_Release –
    ———————-

    function IUnknown_Release (This : access Interface)
      return Win32.ULONG
    is
       use type Interfaces.C.Long;

       lResult : Win32.Long;
       Object  : GNATCOMClass_Pointer := To_Object_Pointer (This.CoClass);
    begin
       --  InterlockedDecrement is a thread protected Win32 API function
       --  to decrement a long
       lResult :=
         Win32.Winbase.InterlockedDecrement (Object.Ref_Count'Access);

       if
         Win32.Winbase.InterlockedDecrement (This.Ref_Count'Access) /= 0
       then
          return Win32.ULONG (This.Ref_Count);

       else
          --  Last reference to Interface so free it
          Free (This.all'Address);
          return 0;
       end if;

    end IUnknown_Release;

The free procedure deallocates the interface instance from memory since the reference counter has reached zero. With in the free procedure the reference count of the object is also decremented. If it reaches zero, the the instance data is also freed destroying the COM object as it is no longer in use.

The implementation of QueryInterface is similar from one object to the next, but needs to be customized to support the interfaces exposed by the COM object. In the example below, an elsif for each supported interface needs to be added after the support for `IUnknown`. The same pattern is followed, but the assignment of the table of access to functions is changed to the appropriate one for the requested interface.

    function IUnknown_QueryInterface
      (This      : access Interface;
       riid      : in     Win32.Objbase.REFIID;
       ppvObject : access Win32.PVOID)
      return HRESULT
    is
       use type Win32.Rpcdce.Guid;

       New_Interface : aliased Interface_Pointer;
       lResult       : Win32.LONG;
       Result        : Win32.ULONG;
       Object        : GNATCOMClass_Pointer :=
                            To_Object_Pointer (This.CoClass);
    begin
       if riid.all = IID_IUnknown then
          -- Since IUnknown is the parent of every interface, just
          -- return back a pointer to this interface with an additional
          -- reference count and the client will use it as if it was
          -- IUnknown
          ppvObject.all := This.all'Address;
          Result := IUnknown_AddRef (This);

       elsif Riid.all = IID_IDispatch then
          New_Interface := new Interface;
          New_Interface.CoClass := This.CoClass;
          lResult :=
             Win32.Winbase.InterlockedIncrement (Object.Ref_Count'Access);
          New_Interface.Vtbl := IGNATMessage_Vtbl'Address;
          ppvObject.all := New_Interface.all'Address;

       elsif Riid.all = IID_IGNATMessage then
          New_Interface := new Interface;
          New_Interface.CoClass := This.CoClass;
          lResult :=
             Win32.Winbase.InterlockedIncrement (Object.Ref_Count'Access);
          New_Interface.Vtbl := IGNATMessage_Vtbl'Address;
          ppvObject.all := New_Interface.all'Address;

       elsif Riid.all = IID_IGNATStat then
          New_Interface := new Interface;
          New_Interface.CoClass := This.CoClass;
          lResult :=
             Win32.Winbase.InterlockedIncrement (Object.Ref_Count'Access);
          New_Interface.Vtbl := IGNATStat_Vtbl'Address;
          ppvObject.all := New_Interface.all'Address;

       else
          ppvObject.all := System.Null_Address;
          return Win32.Winerror.E_NOINTERFACE;
       end if;

       return Win32.Winerror.S_OK;
    end Iunknown_QueryInterface;

Once `IUnknown` methods have been implemented the only additional work is to implement each interface method. In order to have access to the object instance data, a conversion function is used on the `CoClass` member of the interface type like this one:

    function To_Object_Pointer is
       new Ada.Unchecked_Conversion (System.Address,
                                     GNATCOMClass_Pointer);

A simple method implementation may look something like this:

    function IGNATStat_Calls
      (This          : access Interface;
       NumberOfTimes : access Interfaces.C.int)
      return HRESULT
    is
       Object : GNATCOMClass_Pointer := To_Object_Pointer (This.CoClass);
    begin
       Message_Box("Calls", Integer'Image (Object.Count));
       NumberOfTimes.all := Interfaces.C.int (Object.Count);

       return Win32.Winerror.S_OK;
    end IGNATStat_Calls;

Next: Step 4 - Class Factory Implementation, Previous: Step 2 - Base package, Up: The COM object implementation [Contents][Index]