5.1.2 Step 2 - Base package

The top level package for implementing the COM object will contain global reference counters, GUID definitions, and types.

There are two main global reference counters needed for COM objects a component count and a server lock count. The component count is used to identify when to shutdown the server and the server lock provides a means to lock the server in memory to enhance performance when objects will be created and deleted frequently.

There are three types of GUID definitions needed, library ID, class IDs, and interface IDs. These are the GUIDs defined in the IDL for the library, coclass’es, and interface’s. For example:

--  LIBID of library GNATCOMLibrary
--  {45F9F480-787C-11D3-821C-52544C1913DE}

LIBID_GNATCOMLibrary : aliased Win32.Objbase.IID :=
  (16#45F9F480#, 16#787C#, 16#11D3#,
    (char'Val (16#82#), char'Val (16#1C#),
     char'Val (16#52#), char'Val (16#54#),
     char'Val (16#4C#), char'Val (16#19#),
     char'Val (16#13#), char'Val (16#DE#)));

The types needed for implementation are access functions for every method used by the interfaces of the COM object including those used in the interfaces’ parents. Along with an interface type that will be the will be a an access parameter in the first position of every method. The interface type will contain the address of the instance data for the object and a reference count for the interface. This reference count allows for instances of the interface to automatically be deallocated from memory when the interface count reaches zero. For example:

--  Access function types for IGNATStat

type af_IGNATStat_Calls is access
  function (This          : access Interface;
            NumberOfTimes : access Interfaces.C.int)
  return HRESULT;
pragma Convention (StdCall, af_IGNATStat_Calls);

type Interface is record
   Vtbl      : System.Address;
   Ref_Count : aliased Win32.LONG := 1;
   CoClass   : System.Address;
end record;
pragma Convention (C, Interface);

Additionally a boolean variable is added to the package indicating if the object is in an InProc Server or a Local Server, and a procedure called Can_Close that is called every time an object is released, so that in the event the object is contained in a Local Server, if all objects are released and there are no server locks, the server can close itself down. The implementation of Can_Close is:

procedure Can_Close is
   bResult : Win32.BOOL;
begin
   if Server_Lock_Count = 0
     and then Component_Count = 0
     and then InProcServer /= True
   then
      bResult := Win32.Winuser.PostThreadMessage
        (Win32.Winbase.GetCurrentThreadId,
         Win32.Winuser.WM_QUIT,
         0,
         0);
   end if;
end Can_Close;