GNATCOM Overview: Creating a COM Object

5.1 Creating a COM Object

Create IDL
The first step is to create an IDL file that conforms to OLE Automation specifications. See COM/DCOM/COM+ with GNAT documentation for more information on creating compatible IDL files for use with GNAT.

This tutorial uses the gnatexample.idl found in the Docs/Tutorial directory containing one COM object, GNATCOMClass, that has two interfaces, IGNATMessage (a dual interface) and IGNATStat (a custom COM interface).
Compile IDL to a TypeLibrary
Compile gnatexample.idl using MIDL included with Visual Studio and the Microsoft SDK tools. This will produce the typelibrary gnatexample.tlb and a number of .h and .c files that can be erased.
Generate code for COM object
Execute the following command:
```
CreateCOM gnatexample.tlb GNATExample
```
This will create all the code needed to implement the COM object.
With support for dual interface
Edit the file gnatexample-gnatcomclass.ads and add a with of the package GNATCOM.Create.IDispatch.
```
with GNATCOM.Create.IDispatch;
```
This will include support to implement the automation (IDispatch) portion of the interface IGNATMessage for the object.
Add dual interface support to object
Add an IDispatch_Type object to the class record GNATCOMClass_Type.
```
   type GNATCOMClass_Type is
     new GNATCOM.Create.COM_Interface.CoClass_Type (GUID_Map'Access) with
      record

         Data : aliased GNATCOM.Create.IDispatch.IDispatch_Type
           (IID_IGNATMessage'Access,
            LIBID_GNATCOMLibrary'Access, 1, 0);

      end record;
```
The options for the IDispatch_Type are the dual interface IID, the type library and the major and minor version (see the specs for the IDispatch support for more information). The IIDs and the LIBID can be found in the root package GNATExample.ads.

Fill in dual interface support methods

In function IGNATMessage_GetTypeInfoCount replace the return GNATCOM.E_NOTIMPL; with:

      return GNATCOM.Create.IDispatch.GetTypeInfoCount (pctinfo);

In function IGNATMessage_GetTypeInfo replace the return GNATCOM.E_NOTIMPL; with:

      return GNATCOM.Create.IDispatch.GetTypeInfo (Object.Data'Access,
                                                   itinfo,
                                                   pptinfo);

In function IGNATMessage_GetIDsOfNames replace the return GNATCOM.E_NOTIMPL; with:

      return GNATCOM.Create.IDispatch.GetIDsOfNames (Object.Data'Access,
                                                     rgszNames,
                                                     cNames,
                                                     rgdispid);

In function IGNATMessage_Invoke replace the return GNATCOM.E_NOTIMPL; with:

      return GNATCOM.Create.IDispatch.Invoke (This,
                                              Object.Data'Access,
                                              dispidMember,
                                              wFlags,
                                              pdispparams,
                                              pvarResult,
                                              pexcepinfo,
                                              puArgErr);

Add data members to object

Add members to the class record to store object instance data. In this case an integer variable is added to the record to keep count of the number of times members have been called of the IGNATMessage interface.

   type GNATCOMClass_Type is
     new GNATCOM.Create.COM_Interface.CoClass_Type (GUID_Map'Access) with
      record
         Data  : aliased GNATCOM.Create.IDispatch.IDispatch_Type
           (IID_IGNATMessage'Access,
            LIBID_GNATCOMLibrary'Access, 1, 0);

         Count : Integer := 0;

      end record;

Implement remaining COM object methods

Add with Win32.User; to the package and then fill in the lines in bold in to the IGNATMessage_Beep function removing the old return GNATCOM.E_NOTIMPL; line.

   function IGNATMessage_Beep
     (This : access
        GNATCOM.Create.COM_Interface.COM_Interface_Type)
     return GNATCOM.Types.HRESULT
   is
      Object   : Pointer_To_GNATCOMClass_Type :=
        Pointer_To_GNATCOMClass_Type (This.CoClass);

      RetValue : Win32.BOOL;

   begin

      RetValue := Win32.WinUser.MessageBeep (Win32.WinUser.MB_ICONEXCLAMATION);
      Object.Count := Object.Count + 1;
      return GNATCOM.S_OK;

   end IGNATMessage_Beep;

Add with GNATCOM.Utility; and with GNATCOM.BSTR to the package and fill in the lines in bold in to the IGNATMessage_MessageBox function removing the old return GNATCOM.E_NOTIMPL; line. (Note that Ada exceptions should never be allowed to propagate beyond the COM object.)

   function IGNATMessage_MessageBox
     (This    : access
        GNATCOM.Create.COM_Interface.COM_Interface_Type;
      Message : GNATCOM.Types.BSTR)
     return GNATCOM.Types.HRESULT
   is
      Object : Pointer_To_GNATCOMClass_Type :=
        Pointer_To_GNATCOMClass_Type (This.CoClass);
   begin

      GNATCOM.Utility.Message_Box ("GNATCOM",
                                   GNATCOM.BSTR.To_Ada (Message, False));
      Object.Count := Object.Count + 1;
      return GNATCOM.S_OK;
   exception
      when others =>
         return GNATCOM.E_FAIL;

   end IGNATMessage_MessageBox;

Fill in the lines in bold in to the IGNATStat_Calls function removing the old return GNATCOM.E_NOTIMPL; line.

   function IGNATStat_Calls
     (This          : access
        GNATCOM.Create.COM_Interface.COM_Interface_Type;
      NumberOfTimes : GNATCOM.Types.Pointer_To_int)
     return GNATCOM.Types.HRESULT
   is
      Object : Pointer_To_GNATCOMClass_Type :=
        Pointer_To_GNATCOMClass_Type (This.CoClass);
   begin

      NumberOfTimes.all := Interfaces.C.Int (Object.Count);
      return GNATCOM.S_OK;

   end IGNATStat_Calls;

Compile and Register Object
Compile the COM object by running the generated make.bat file. Then register either the Dll version, by typing regsvr32 gnatexample-dll.dll or the Exe version, by typing gnatexample-exe /RegServer.

The COM object is now ready for use.