6.8 Packaging it all up

To package and advertise the Haskell COM component to the outside world, we need to finally define the following (assuming the component will be located in a DLL):

• A class factory for it.
• The DLL entry point DllGetClassObject()
• The entry points for DLL self-registration.

Starting with the factory, here's the boilerplate version we will provide per component:

HRESULT STDCALL
CreateInstance(IUnknown *pUnknownOuter,
               REFIID riid,
               void** ppv)
{
  void *pInterface;
  HRESULT hr;

  if (pUnknownOuter != NULL) {
     return CLASS_E_NOAGGREGATION;
  }
 
  hr = new(riid,ppv);
  return hr;
}

static long serverLocks = 0;

HRESULT STDCALL
LockServer(BOOL lock)
{
  if (lock) {
    InterlockedIncrement(&serverLocks);
  } else {
    InterlockedDecrement(&serverLocks);
  }
}

The only interesting line of code here is the call to new, which invokes the component constructor that was generated as part of the component constructor stubs in Section Creating a component instance.

DLL support

To support the (un)loading and registration of a Haskell COM component we also provide a bunch of boilerplate code to stick into a DLL:

ToDo:Insert table based boilerplate implementation of DllGetClassObject() and friends to avoid the need to hard code CLSIDs.

DEFINE_GUID(CLSID_IntRef,0xC1DF9B11,0xBDDB,0x11d1,0x99,0xCC,
            0x0,0x60,0x97,0xB7,0x31,0x4A);

HRESULT DllGetClassObject(
         REFCLSID rclsid,
         REFIID   riid,
         void**   ppv)
{
  HRESULT hr;
  
  if (*rclsid != CLSID_IntRef) {
    return CLASS_E_NOTAVAILABLE;
  }

  void *vec[] = { QueryInterface, AddRef, Release, CreateInstance,
                  LockServer };
  IIntRef *iptr = mkVTBL(&IID_IIntRef, vec);
  if (iptr == NULL) {
     return E_OUTOFMEMORY;
  }
  hr = IUnknown_QueryInterface(iptr,riid,ppv);
  IUnknown_Release(iptr);
  return hr;
}

HRESULT stdcall DllCanUnloadNow()
{
  if (&serverLocks == 0) {
    return S_OK;
  } else {
    return S_FALSE;
  }
}
extern HRESULT  RegAddEntry(HMODULE hMod,
                            REFCLSID rclsid,
                            const char* path,
                            const char* subkey,
                            const char* value) ;

HRESULT stdcall DllRegisterServer()
{
 return (RegAddEntry(hMod,
                     &CLSID_IntRef,
                     "IntRef",
                     "IntRef",
                     "IntRef.1");)
}

extern HRESULT  RegRemoveEntry(REFCLSID rclsid,
                               const char* progId,
                               const char* progIdVersion) ;
HRESULT stdcall DllUnregisterServer()
{
 return (RegRemoveEntry(&CLSID_IntRef,
                        "IntRef",
                        "IntRef.1");)

}
static HANDLE hMod = 0;

BOOL stdcall DllMain (
         HANDLE hModule,
         DWORD  reason,
         void*  reserved)
{
  if (reason == DLL_PROCESS_ATTACH)  {
     hMod = hModule;
  }
  return TRUE;
}