Next: Using a COM Object, Up: Tutorial [Contents][Index]

### 5.1 Creating a COM Object

1. 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).

2. 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.

3. 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.

4. `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.

5. 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`.

6. 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);

7. 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;

8. 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;

9. 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.

Next: Using a COM Object, Up: Tutorial [Contents][Index]