Print

Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

[Paul Squires]

Thanks Jose, yes I was aware of those functions because I use them to generate unique GUIDs for the tools in the User Tools dialog within WinFBE. I like the idea of having it built into the editor or having it as a standalone tool that can be called from WinFBE's User Tools via hot key. Given that it is a very specific functionality I think having it as a User Tool would be preferable. Other things like popup ASCII charts, keycode charts, or color values/color pickers, could also be User Tools.

[José Roca]

Low-level COM is very straightforward. To create an instance of an object you call CoCreateInstance, that is a convenience wrapper for

Code: [Select]

CoGetClassObject(rclsid, dwClsContext, NULL, IID_IClassFactory, &pCF);
hresult = pCF->CreateInstance(pUnkOuter, riid, ppvObj)
pCF->Release();

CoGetClassObject loads the library with LoadLibrary, just like any other DLL, and calls the function DllGetClassObject, that every COM server must implement and export. DllGetClassObject creates an instance of the class factory and returns a pointer to its virtual table. Once CoGetClassObject has retrieved the class factory pointer, it calls its CreateInstance method, that creates an instance of the requested object (identified by its unique CLSID and IID) and returns a pointer to its virtual table. Then you call the methods using offsets to the virtual table.

It is similar to using LoadLibrary and GetProcAddress, but instead of a pointer to a single function you get the address of a virtual table, that is just an array of pointers to the methods of the object. Because it returns the address of the virtual table instead of a direct pointer, double indirection must be used. This is because the virtual table is treated as an array. But unless you call the function pointers directly, as I did years ago with PB's CALL DWORD, you don't have to worry about double indirection and offsets becase the compiler calculates them based in the declares for the interface. For an interface that inherits from IUnknown, QueryInterface has the offset 0, AddRef the offset 4 (or 8 in 64 bit, the size of a pointer), Release the offset 8 (or 16 in 64 bit) and then the implemented custom methods follow.

That is, instead of retrieving pointers to the functions individually, as with GetProcAddess, you get the address of an array of pointers to all the methods of the object. Because classes are very convenient to group these methods, they are the prefered way, but you could use just an array or an UDT. It is the old good way of calling a function through a pointer. Nothing more. The use of classes and the dotted syntax is just for convenience, but has nothing to do with OOP.

They also implement a simple reference count that starts at 1 when you create the object, is incremented when you call AddRef or QueryInterface and is decremented when you call Release. When the count reaches 0, the object commits suicide

Automation is very complicated and confusing, and because each compiler has its own way to work with strings and arrays, they discarded them and invented new ones: VARIANTs, BSTRs and safe arrays. They also designed its "forms" as a sophisticated OLE container and wrote OCXs. As the form was an OLE container, the OCXs integrated very well with it, but when yo use a SDK window, an OCX does not became integrated and you need an OLE container to act as a middleman. They also designed a system to raise events that worked very well with VB because it was designed for it, but when you try to use them in another compiler it becames complicated. And then all that nasty business of registering the OCX in the registry, etc. As you can see, you can use a COM server without registering it.

One of my overloaded AfxNewCom functions is a replacement for CoCreateInstance and clearly shows all the process, with two added touches: contrarily to CoCreateInstance, it can use unregistered servers and it is also able to create instances of licensed controls.

Code: [Select]

' ========================================================================================
' Loads the specified library from file and creates an instance of an object.
' Parameters:
' - wszLibName = Full path where the library is located.
' - rclsid = The CLSID (class identifier) associated with the data and code that will be
'   used to create the object.
' - riid = A reference to the identifier of the interface to be used to communicate with the object.
' - wszLicKey = The license key.
' If it succeeds, returns a reference to the requested interface; otherwise, it returns null.
' Not every component is a suitable candidate for use under this overloaded AfxNewCom function.
'  - Only in-process servers (DLLs) are supported.
'  - Components that are system components or part of the operating system, such as XML,
'    Data Access, Internet Explorer, or DirectX, aren't supported
'  - Components that are part of an application, such Microsoft Office, aren't supported.
'  - Components intended for use as an add-in or a snap-in, such as an Office add-in or
'    a control in a Web browser, aren't supported.
'  - Components that manage a shared physical or virtual system resource aren't supported.
'  - Visual ActiveX controls aren't supported because they need to be initilized and
'    activated by the OLE container.
' Note: Do not use DyLibFree to unload the library once you have got a valid reference
' to an interface or your application will GPF. Before calling DyLibFree, all the
' interface references must be released. If you don't need to unload the library until
' the application ends, then you don't need to call DyLibFree because CoUninitialize
' closes the COM library on the current thread, unloads all DLLs loaded by the thread,
' frees any other resources that the thread maintains, and forces all RPC connections on
' the thread to close.
' ========================================================================================
PRIVATE FUNCTION AfxNewCom OVERLOAD (BYREF wszLibName AS CONST WSTRING, BYREF rclsid AS CONST CLSID, BYREF riid AS CONST IID, BYREF wszLicKey AS WSTRING = "") AS ANY PTR

   DIM hr AS LONG, hLib AS HANDLE, pDisp AS ANY PTR
   DIM pIClassFactory AS IClassFactory PTR, pIClassFactory2 AS IClassFactory2 PTR

   ' // See if the library is already loaded in the address space
   hLib = GetModuleHandleW(wszLibName)
   ' // If it is not loaded, load it
   IF hLib = NULL THEN hLib = DyLibLoad(wszLibName)
   ' // If it fails, abort
   IF hLib = NULL THEN EXIT FUNCTION

   ' // Retrieve the address of the exported function DllGetClassObject
   DIM pfnDllGetClassObject AS FUNCTION (BYVAL rclsid AS CONST IID CONST PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL ppv AS LPVOID PTR) AS HRESULT
   pfnDllGetClassObject = DyLibSymbol(hLib, "DllGetClassObject")
   IF pfnDllGetClassObject = NULL THEN EXIT FUNCTION

   IF LEN(wszLicKey) = 0 THEN
      ' // Request a reference to the IClassFactory interface
      hr = pfnDllGetClassObject(@rclsid, @IID_IClassFactory, @pIClassFactory)
      IF hr <> S_OK THEN EXIT FUNCTION
      ' // Create an instance of the server or control
      hr = pIClassFactory->lpVtbl->CreateInstance(pIClassFactory, NULL, @riid, @pDisp)
      IF hr <> S_OK THEN
         pIClassFactory->lpVtbl->Release(pIClassFactory)
         EXIT FUNCTION
      END IF
   ELSE
      ' // Request a reference to the IClassFactory2 interface
      hr = pfnDllGetClassObject(@rclsid, @IID_IClassFactory, @pIClassFactory2)
      IF hr <> S_OK THEN EXIT FUNCTION
      ' // Create a licensed instance of the server or control
      hr = pIClassFactory2->lpVtbl->CreateInstanceLic(pIClassFactory2, NULL, NULL, @riid, @wszLicKey, @pDisp)
      IF hr <> S_OK THEN
         pIClassFactory2->lpVtbl->Release(pIClassFactory2)
         EXIT FUNCTION
      END IF
   END IF

   IF pIClassFactory THEN pIClassFactory->lpVtbl->Release(pIClassFactory)
   IF pIClassFactory2 THEN pIClassFactory2->lpVtbl->Release(pIClassFactory2)
   RETURN pDisp

END FUNCTION
' ========================================================================================

In short, low-level COM is just a way to group related procedures and data, like the FB classes, but as it is a binary standard with some strict rules (*), any language that can call functions through pointers can use them. Also instead of destroying the object with Delete, it implements a reference count and self-destruction, and instead of name mangling, it uses class identifiers and interface identifiers.

(*) Not many: To implement and export DllGetClassObject, to implement a class factory and to implement reference counting with the QueryInterface, AddRef and Release methods. QueryInterface is used to "navigate" between interfaces if the server implements more than one.

[José Roca]

> It is pretty cool how you simplified the code as your examples progressed simply by using EXTENDS and the virtual and abstract functions.

This is a nice feature of the compiler and it is not related to COM.

Extending from Afx_IUnknown, that in turn extends OBJECT, allows the use of virtual methods in the class and ABSTRACT methods in the declares. The difference between virtual and abstract methods is that the virtual ones require implementation, i.e. they are used to write the procedures, and the abstract ones don't, so they are used for the declares.

The built-in OBJECT type

Code: [Select]

Type object
   As fb_BaseVT Ptr vtable_ptr
   Declare Constructor()
End Type

has as the first member a pointer to the virtual table of the object. The virtual table pointer is used to dispatch Virtual and Abstract methods and passes the address of the virtual table (know as this in C and ME in VB and PB) as an hidden parameter to all the methods. This allows to construct a FB class as a COM virtual table and also allows an easier syntax when calling methods <pInterface>.<method name> (parameters) instead of <pInterface>->lpvtbl-><method name>(<pInteface>, <parameters>). Since COM will only care about the array of pointers at the beginning of the virtual table (as long as your declares aren't wrong and you end calling a wrong offset), the table can contain additional pointers to wathever you wish to use them, usually data. Using a FB class has the advantage that the compiler will take care of the dirty work. Therefore, you can use all kind of public and private data.

The only precaution is to not mess the virtual table, although if you do it the compiler and/or the linker will fail. This is why in the following declaration of the FB class the virtual methods come first, followed with the other stuff, even the constructor and destructor of the class. This allows to pass a pointer to the class to COM as if it was a virtual table (array of pointers).

Code: [Select]

TYPE IExample EXTENDS Afx_IUnknown
   ' Functions for the IUnknown Interface
   DECLARE VIRTUAL FUNCTION QueryInterface (BYVAL vTableGuid AS CONST IID CONST PTR, BYVAL ppv AS ANY PTR PTR) AS HRESULT
   DECLARE VIRTUAL FUNCTION AddRef () AS ULONG
   DECLARE VIRTUAL FUNCTION Release () AS ULONG
   ' Our functions
   DECLARE VIRTUAL FUNCTION SetString (BYVAL pwsz AS WSTRING PTR) AS HRESULT
   DECLARE VIRTUAL FUNCTION GetString (BYVAL pbuffer AS WSTRING PTR, BYVAL cch AS DWORD) AS HRESULT
   ' Constructor/destructor
   DECLARE CONSTRUCTOR
   DECLARE DESTRUCTOR
   ' Data
   count AS DWORD
   buffer AS WSTRING * 80
END TYPE

And that's all (unless I'm forgetting something). Anybody proficient with the use of pointers should have not many problems understanding it if he is able of not mix it with all that Automation garbage.

[José Roca]

Before someone asks why I'm not calling CoInitialize in the DLL...

From MSDN:

Because there is no way to control the order in which in-process servers are loaded or unloaded, do not call CoInitialize, CoInitializeEx, or CoUninitialize from the DllMain function.

[José Roca]

The beauty of this technique is that if you make a FB DLL using FB classes, it won't work with other compilers, but wrapping it as a COM object, it works with any language that can call functions through pointers.

[José Roca]

This is a revised version of the example. Demonstrates that we can also use our own data types such CBSTR, CWSTR and CVAR. Of course, if we intend to use the DLL with other languages, then we can't do that beause the other language does not know how to deal with them and we will have to return standard data types such BSTR, WSTRING PTR and VARIANT.

My idea of converting the factory class into a virtual class doesn't seem possible. First, we only need a class factory, so a static one is enough; second, the CreateInstance method of the factory class needs to know the name of the class to create; third, Free Basic does not support to have more than one interface in a class.

DLL code:

Code: [Select]

' // Free Basic source code to a simple COM object, compiled into an ordinary
' // dynamic link library (DLL).

#include once "windows.bi"
#include once "win/ocidl.bi"
#include once "Afx/AfxCOM.inc"
#include once "Afx/CWSTR.inc"
#include once "Afx/CVar.inc"
using Afx

' Things to change:
' - The name of the interface
' - CLSID and IID of the inteface
'   - Replace CLSID_IExample and IID_IExample with the names of your election
'   - Replace CLSID_IExample in the DllGetClassObject function
'   - Replace IID_IExample in the QueryInteface method of the class
' - Our virtual functions
' - The variables to store data

' Things to keep:
' - The virtual methods QueryInterface, AddRef and Release
' - The static variables OutstandingObjects and LockCount

' // Our IExample CLSID (class identifier)
' // {6899A2A3-405B-44d4-A415-E08CEE2A97CB}
' // (*** change it***)
DIM SHARED CLSID_IExample AS GUID = TYPE(&h6899A2A3, &h405B, &h44D4, {&hA4, &h15, &hE0, &h8C, &hEE, &h2A, &h97, &hCB})

' // Our IExample IID (interface identifier)
' // {74666CAC-C2B1-4FA8-A049-97F3214802F0}
' // (*** change it***)
DIM SHARED IID_IExample AS GUID = TYPE(&h74666CAC, &hC2B1, &h4FA8, {&hA0, &h49, &h97, &hF3, &h21, &h48, &h02, &hF0})

' // A count of how many objects our DLL has created (by some
' // app calling our IClassFactory object's CreateInstance())
' // which have not yet been Release()'d by the app
' // (***keep it***)
STATIC SHARED OutstandingObjects AS DWORD

' // A count of how many apps have locked our DLL via calling our
' // IClassFactory object's LockServer()
' // (***keep it***)
STATIC SHARED LockCount AS DWORD

' ========================================================================================
' IExample object
' ========================================================================================
TYPE IExample EXTENDS OBJECT
   ' Functions for the IUnknown Interface (*** keep them ***)
   DECLARE VIRTUAL FUNCTION QueryInterface (BYVAL riid AS CONST IID CONST PTR, BYVAL ppvObj AS ANY PTR PTR) AS HRESULT
   DECLARE VIRTUAL FUNCTION AddRef () AS ULONG
   DECLARE VIRTUAL FUNCTION Release () AS ULONG
   ' Our functions (*** change them ***)
   ' / ------------------------------------------------
   ' // Adequate for use with other languages that won't understand our CBSTR class
   ' // The caller will be responsible of freeing the returned BSTR with SysFreeString
   ' // PowerBASIC will attach the handle and free it when the WSTRING will go out of scope
   ' // e.g. LOCAL ws AS WSTRING = pExample.GetString
   ' // If called with Free Basic, we must assign it to a CBSTR to avoid memory leaks, e.g.
   ' // DIM cbs AS CBSTR = pExample->GetString
   DECLARE VIRTUAL SUB SetString (BYVAL bs AS AFX_BSTR)
   DECLARE VIRTUAL FUNCTION GetString () AS AFX_BSTR
   ' / ------------------------------------------------
   ' // If we are going to use the server only with Free Basic, we can use CBSTR
   DECLARE VIRTUAL PROPERTY MyCBStr (BYREF cbs AS CBSTR)
   DECLARE VIRTUAL PROPERTY MyCBStr () AS CBSTR
   ' / ------------------------------------------------
   DECLARE VIRTUAL PROPERTY MyCWStr (BYREF cws AS CWSTR)
   DECLARE VIRTUAL PROPERTY MyCWStr () AS CWSTR
   DECLARE VIRTUAL PROPERTY MyCVar (BYREF cv AS CVAR)
   DECLARE VIRTUAL PROPERTY MyCVar () AS CVAR
   DECLARE VIRTUAL PROPERTY MyNumber (BYVAL num AS DOUBLE)
   DECLARE VIRTUAL PROPERTY MyNumber () AS DOUBLE
   ' Constructor/destructor
   DECLARE CONSTRUCTOR
   DECLARE DESTRUCTOR
   ' Reference count
   cRef AS DWORD ' (*** keep it ***)
   ' Data (*** change it ***)
   m_MyCBStr AS CBSTR
   m_MyCWStr AS CWSTR
   m_MyCVar AS CVAR
   m_MyNumber AS DOUBLE
END TYPE
' ========================================================================================

' ========================================================================================
' IExample constructor
' ========================================================================================
CONSTRUCTOR IExample
END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
' IExample destructor
' ========================================================================================
DESTRUCTOR IExample
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' IExample's QueryInterface
' (***change IID_IExample***)
' ========================================================================================
FUNCTION IExample.QueryInterface (BYVAL riid AS CONST IID CONST PTR, BYVAL ppvObj AS ANY PTR PTR) AS HRESULT
   ' // Check if the GUID matches the IID of our interface or the IUnknown interface.
   IF IsEqualIID(riid, @IID_IUnknown) = FALSE AND IsEqualIID(riid, @IID_IExample) = FALSE THEN
      ' // We don't recognize the GUID passed to us. Let the caller know this,
      ' // by clearing his handle, and returning E_NOINTERFACE.
      *ppvObj = 0
      RETURN E_NOINTERFACE
   END IF
   ' // Fill in the caller's handle
   *ppvObj = @this
   ' // Increment the count of callers who have an outstanding pointer to this object
   this.AddRef
   RETURN NOERROR
END FUNCTION
' ========================================================================================

' ========================================================================================
' IExample's AddRef
' ========================================================================================
FUNCTION IExample.AddRef() AS ULONG
   ' // Increment IExample's reference count, and return the updated value.
   this.cRef += 1
   RETURN this.cRef
END FUNCTION
' ========================================================================================

' ========================================================================================
' IExample's Release
' ========================================================================================
FUNCTION IExample.Release () AS ULONG
   ' // Decrement IExample's reference count
   this.cRef -= 1
   ' // If 0, then we can safely free this IExample now
   IF this.cRef = 0 THEN
      Delete @this
      InterlockedDecrement(@OutstandingObjects)
      RETURN 0
   END IF
   RETURN this.cRef
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets/gets a string
' ========================================================================================
SUB IExample.SetString (BYVAL bs AS AFX_BSTR)
   this.m_MyCBStr = bs
END SUB
' ========================================================================================
' ========================================================================================
FUNCTION IExample.GetString () AS AFX_BSTR
   RETURN this.m_MyCBStr
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets/gets a CBSTR
' ========================================================================================
PROPERTY IExample.MyCBStr (BYREF cbs AS CBSTR)
   this.m_MyCBStr = cbs
END PROPERTY
' ========================================================================================
' ========================================================================================
PROPERTY IExample.MyCBStr () AS CBSTR
   RETURN this.m_MyCBStr
END PROPERTY
' ========================================================================================

' ========================================================================================
' Sets/gets a CWSTR
' ========================================================================================
PROPERTY IExample.MyCWStr (BYREF cws AS CWSTR)
   this.m_MyCWStr = cws
END PROPERTY
' ========================================================================================
' ========================================================================================
PROPERTY IExample.MyCWStr () AS CWSTR
   RETURN this.m_MyCWStr
END PROPERTY
' ========================================================================================

' ========================================================================================
' Sets/gets a CVAR
' ========================================================================================
PROPERTY IExample.MyCVar (BYREF cv AS CVAR)
   this.m_MyCVar = cv
END PROPERTY
' ========================================================================================
' ========================================================================================
PROPERTY IExample.MyCVar () AS CVAR
   RETURN this.m_MyCVar
END PROPERTY
' ========================================================================================

' ========================================================================================
' Sets/gets a number
' ========================================================================================
PROPERTY IExample.MyNumber (BYVAL num AS DOUBLE)
   this.m_MyNumber = num
END PROPERTY
' ========================================================================================
' ========================================================================================
PROPERTY IExample.MyNumber () AS DOUBLE
   PROPERTY = this.m_MyNumber
END PROPERTY
' ========================================================================================

' ========================================================================================
' // The IClassFactory object ////////////////////////////////////////////////////////////
' ========================================================================================

' // Since we only ever need one IClassFactory object, we declare
' // it static. The only requirement is that we ensure any
' // access to its members is thread-safe
STATIC SHARED MyIClassFactoryObj As IClassFactory

' // IClassFactory's AddRef()
FUNCTION classAddRef (BYVAL pthis AS IClassFactory PTR) AS ULONG
   ' // Someone is obtaining my IClassFactory, so inc the count of
   ' // pointers that I've returned which some app needs to Release()
   InterlockedIncrement(@OutstandingObjects)

   ' // Since we never actually allocate/free an IClassFactory (ie, we
   ' // use just 1 static one), we don't need to maintain a separate
   ' // reference count for our IClassFactory. We'll just tell the caller
   ' // that there's at least one of our IClassFactory objects in existance
   RETURN 1
END FUNCTION

' // IClassFactory's QueryInterface()
FUNCTION classQueryInterface (BYVAL pthis AS IClassFactory PTR, BYVAL factoryGuid AS CONST IID CONST PTR, BYVAL ppv AS ANY PTR PTR) AS HRESULT
   ' // Make sure the caller wants either an IUnknown or an IClassFactory.
   ' // In either case, we return the same IClassFactory pointer passed to
   ' // us since it can also masquerade as an IUnknown
   IF IsEqualIID(factoryGuid, @IID_IUnknown) OR IsEqualIID(factoryGuid, @IID_IClassFactory) THEN
      ' // Call my IClassFactory's AddRef
      pthis->lpVtbl->AddRef(pthis)
      ' // Return (to the caller) a ptr to my IClassFactory
      *ppv = pthis
      RETURN NOERROR
   END IF
   ' // We don't know about any other GUIDs
   *ppv = 0
   RETURN E_NOINTERFACE
END FUNCTION

' // IClassFactory's Release()
FUNCTION classRelease(BYVAL pthis AS IClassFactory PTR) AS ULONG
   ' // One less object that an app has not yet Release()'ed
   RETURN InterlockedDecrement(@OutstandingObjects)
END FUNCTION

' // IClassFactory's CreateInstance() function. It is called by
' // someone who has a pointer to our IClassFactory object and now
' // wants to create and retrieve a pointer to our IExample
FUNCTION classCreateInstance(BYVAL pthis AS IClassFactory PTR, BYVAL punkOuter AS IUnknown PTR, _
   BYVAL riid AS CONST IID CONST PTR, BYVAL objHandle AS ANY PTR PTR) AS HRESULT

   DIM hr AS HRESULT
   ' // Assume an error by clearing caller's handle
   *objHandle = 0
   ' // We don't support aggregation in this example
   IF punkOuter THEN RETURN CLASS_E_NOAGGREGATION
   ' // Allocate our object (***change the name of the class***)
   DIM thisObj AS IExample PTR = NEW IExample
   ' // Increment the reference count so we can call Release() below and
   '  // it will deallocate only if there is an error with QueryInterface()
   thisobj->cRef = 1
   ' // Fill in the caller's handle with a pointer to the object we just allocated
   ' // above. We'll let the QueryInterface method of the object do that, because
   ' // it also checks the GUID the caller passed, and also increments the
   ' // reference count (to 2) if all goes well
   hr = thisObj->QueryInterface(riid, objHandle)
   ' // Decrement reference count. NOTE: If there was an error in QueryInterface()
   ' // then Release() will be decrementing the count back to 0 and will free the
   ' // IExample for us. One error that may occur is that the caller is asking for
   ' // some sort of object that we don't support (ie, it's a GUID we don't recognize)
   thisObj->Release
   ' // If success, inc static object count to keep this DLL loaded
   IF hr = S_OK THEN InterlockedIncrement(@OutstandingObjects)
   RETURN hr
END FUNCTION

' // IClassFactory's LockServer(). It is called by someone
' // who wants to lock this DLL in memory
FUNCTION classLockServer (BYVAL pthis AS IClassFactory PTR, BYVAL flock AS WINBOOL) AS HRESULT
   IF flock THEN InterlockedIncrement(@LockCount) ELSE InterlockedDecrement(@LockCount)
   RETURN NOERROR
END FUNCTION

STATIC SHARED MyClassFactoryVTbl AS IClassFactoryVTbl = TYPE(@classQueryInterface, _
   @classAddRef, @classRelease, @classCreateInstance, @classLockServer)

' ========================================================================================
' Implementation of the DllGetClassObject and DllCanUnloadNow functions.
' ========================================================================================

EXTERN "windows-ms"

#UNDEF DllGetClassObject
FUNCTION DllGetClassObject ALIAS "DllGetClassObject" (BYVAL objGuid AS CLSID PTR, _
   BYVAL factoryGuid AS IID PTR, BYVAL factoryHandle As VOID PTR PTR) AS HRESULT EXPORT

   DIM hr AS HRESULT
   ' // Check that the caller is passing our interface CLSID.
   ' // That's the only object our DLL implements
   ' // (***change CLSID_IExample***)
   IF IsEqualCLSID(objGuid, @CLSID_IExample) THEN
      ' // Fill in the caller's handle with a pointer to our IClassFactory object.
      ' // We'll let our IClassFactory's QueryInterface do that, because it also
      ' // checks the IClassFactory GUID and does other book-keeping
      hr = classQueryInterface(@MyIClassFactoryObj, factoryGuid, factoryHandle)
   ELSE
      ' // We don't understand this GUID. It's obviously not for our DLL.
      ' // Let the caller know this by clearing his handle and returning
      ' // CLASS_E_CLASSNOTAVAILABLE
      *factoryHandle = 0
      hr = CLASS_E_CLASSNOTAVAILABLE
   END IF
   RETURN hr

END FUNCTION

' * This is called by some OLE function in order to determine
' * whether it is safe to unload our DLL from memory.
' *
' * RETURNS: S_OK if safe to unload, or S_FALSE if not.

' // If someone has retrieved pointers to any of our objects, and
' // not yet Release()'ed them, then we return S_FALSE to indicate
' // not to unload this DLL. Also, if someone has us locked, return
' // S_FALSE

#UNDEF DllCanUnloadNow
FUNCTION DllCanUnloadNow ALIAS "DllCanUnloadNow" () AS HRESULT EXPORT
   RETURN IIF(OutstandingObjects OR LockCount, S_FALSE, S_OK)
END FUNCTION

' ========================================================================================

END EXTERN

' ========================================================================================
' Constructor of the module
' ========================================================================================
SUB ctor () CONSTRUCTOR
'   OutputDebugStringW "DLL loaded"
   ' // Clear static counts
   OutstandingObjects = 0
   LockCount = 0
   ' // Initialize my IClassFactory with the pointer to its VTable
   MyIClassFactoryObj.lpVtbl = @MyClassFactoryVTbl
END SUB
' ========================================================================================

' ========================================================================================
' Destructor of the module
' ========================================================================================
SUB dtor () DESTRUCTOR
'   OutputDebugStringW "DLL unloaded"
END SUB
' ========================================================================================


[José Roca]

Test code:

Code: [Select]

'#CONSOLE ON
#define _CBSTR_DEBUG_ 1
#define UNICODE
#INCLUDE ONCE "windows.bi"
#include once "win/ocidl.bi"
#include once "Afx/AfxCOM.inc"
#include once "Afx/CVAR.inc"
using Afx

' // Our IExample object's GUID
' // {6899A2A3-405B-44d4-A415-E0 8C EE 2A 97 CB}
DIM CLSID_IExample AS GUID = TYPE(&h6899A2A3, &h405B, &h44D4, {&hA4, &h15, &hE0, &h8C, &hEE, &h2A, &h97, &hCB})
' // Our IExample VTable's GUID
' // {74666CAC-C2B1-4FA8-A049-97F3214802F0}
DIM IID_IExample AS GUID = TYPE(&h74666CAC, &hC2B1, &h4FA8, {&hA0, &h49, &h97, &hF3, &h21, &h48, &h02, &hF0})

TYPE IExample EXTENDS Afx_IUnknown
   ' // Adequate for use with other languages that won't understand our CBSTR class
   DECLARE ABSTRACT SUB SetString (BYVAL bs AS AFX_BSTR)
   DECLARE ABSTRACT FUNCTION GetString () AS AFX_BSTR
   ' / ------------------------------------------------
   DECLARE ABSTRACT PROPERTY MyCBStr (BYREF cbs AS CBSTR)
   DECLARE ABSTRACT PROPERTY MyCBStr () AS CBSTR
   DECLARE ABSTRACT PROPERTY MyCWStr (BYREF cws AS CWSTR)
   DECLARE ABSTRACT PROPERTY MyCWStr () AS CWSTR
   DECLARE ABSTRACT PROPERTY MyCVar (BYREF cv AS CVAR)
   DECLARE ABSTRACT PROPERTY MyCVar () AS CVAR
   DECLARE ABSTRACT PROPERTY MyNumber (BYVAL num AS DOUBLE)
   DECLARE ABSTRACT PROPERTY MyNumber () AS DOUBLE
END TYPE

' // Initialize the COM library
CoInitialize NULL

DIM wszLibName AS WSTRING * MAX_PATH = ExePath & "\IExample3.dll"
DIM pExample AS IExample PTR = AfxNewCom(wszLibName, CLSID_IExample, IID_IExample)
print "pExample = ", pExample
IF pExample THEN
   pExample->SetString("Jose Roca")
   ' // As it returns a BSTR, we need to attach it to a CBSTR to avoid a memory leak
   DIM cbs AS CBSTR = pExample->GetString
   PRINT cbs
   ' // -------------------------------------------
   pExample->MyCBStr = "Paul Squires"
   PRINT pExample->MyCBStr
   pExample->MyCWStr = "Free Basic"
   PRINT pExample->MyCWStr
   pExample->MyCVar = "This is a variant"
   PRINT pExample->MyCVar.ToStr
   pExample->MyNumber = 123456.78
   PRINT pExample->MyNumber
END IF
AfxSafeRelease(pExample)

' // Uninitialize the COM library
CoUninitialize

PRINT
PRINT "Press any key..."
SLEEP


[Marc Pons]

Hi Jose, very good job 

just some points to share here about fb dll  creation-usage

specific dllmain
can be done easily like that

Code: [Select]

' entry point dll    'use any name you want but better to stay with uppercase name
#ifdef  __FB_64BIT__

  Function _MYDLLMAIN Alias " _MYDLLMAIN" ( ByVal hinstDLL As HINSTANCE, _
                  ByVal fdwReason As Long, _
                  Byval lpvReserved As LPVOID ) As Long
#else
  Function MYDLLMAIN ( ByVal hinstDLL As HINSTANCE, _
                  ByVal fdwReason As Long, _
                  Byval lpvReserved As LPVOID ) As Long
#endif

   Select Case fdwReason
      Case DLL_PROCESS_ATTACH
        function = dll_init()  ' your user init function, use any name it's your function
        exit function
      Case DLL_PROCESS_DETACH
        function =  dll_detach()  ' your user detach function, use any name it's your function
        exit function
   End Select

   function = 1
  End Function



to compile :

"c:\Freebasic_Path\fbc.exe" -x "NAME.dll" -dll -export -Wl "--kill-at --entry _MYDLLMAIN" NAME.bas -v -w pedantic > NAME.log 2>&1

where
-Wl "--kill-at --entry _MYDLLMAIN"

are linker parameters

--kill-at   ; to not have decorated functions@x 
-- entry _MYDLLMAIN  ; define the specific entry dll point use always uppercase

a tip : because win32 add underscore as first character(even you did not put it on the code)
it is interresting on win64 to add it in the code, so the command line to compile will be the same for win32/win 64.

that why i've put the conditionnal compilation on the code


about interface libxxx.dll.a
you can use the tool i've posted here on the forum to create interface for win32/win64 dll
but in fact you only need that interface : if at compile time the dll is not on the same folder as the .bas you are compiling
if it is on the same folder , you don't need to have the .dll.a  ( it just an helper way)
if you have a .dll.a it has to be placed in the compiler lib folder or in the same folder as the .bas you are compiling

so if the idea is to produce an executable whith specific dll , just put the dll on the folder you have the source
and when using/deploying  put the dll near the executable that need it (or on the system32 )

using dll functions
if you compile the dll as i've showed above, the easiest way to use the exported functions :

Code: [Select]

"Windows-ms" Lib "NAME"
Declare Function your_dllfunction Alias "YOUR_DLLFUNCTION" (ByVal Hparent As HWND) As Long
End Extern

hope can help

Marc

[Paul Squires]

Hi Marc,

My understanding is that the COM dll does not need a dllmain. Jose is using the module constructor/destructor to handle the same functionality as provided by dllmain. You can read that in this post: http://www.planetsquires.com/protect/forum/index.php?topic=4073.msg30861#msg30861

Also, as a COM server I do not believe that a dll.a interface file at all. This is a great benefit of the COM type of dlls.

Jose can correct me if I'm wrong.

[José Roca]

A DLLMAIN is not needed because we can use the constructor and destructor of the module.

Unless we export functions that are not methods of the class, we don't need an import library at all.

Using registration free techniques, such my overloaded function AfxNewCom or PowerBASIC NEWCOM CLSID $CLSID_IExample LIB LibName, we can put the COM DLL anywhere.

[José Roca]

To allow the use of our data types and also compiling for other languages, we can use conditional compiling, e.g.

Code: [Select]

#IF USE_FB
PROPERTY IExample.MyCBStr () AS CBSTR
#ELSE
PROPERTY IExample.MyCBStr () AS AFX_BSTR
#ENDIF


[José Roca]

Hi Marc,

Thanks very much for your tips. Maybe I will have a use for them some day, but currently I'm trying to avoid these import libraries like a pest. I hate to have to say to a user things like "you have to use this switch when compiling", "you have to copy the import library in the xxx folder", etc. Where is the real need for all these complications?

Place the COM dll where you wish and specify the full path to it when calling AfxNewCom. No need to register it, no need for an import library, no nothing.

[José Roca]

The technique that I'm using is very simple.

To use the COM DLL you have to use AfxNewCom (NEWCOM with PowerBasic), that does the following:

- Loads the COM DLL.

- Calls the exported function DllGetClassObject, that returns a pointer to the factory class.

- Calls the CreateInstance method of the factory class, that creates an instance of the requested COM class (identified by a CLSID and an IID) and returns a pointer to it, allowing to call the implemented methods of the class.

- The class implements a reference count managed by its QueryInterface, AddRef and Release methods, and kills itself when the reference count reaches 0.

That's all!

[José Roca]

If somebody does not know it, we can use any name in the interface declaration because what identifies the object is not the name of the class but its CLSID and IID. Therefore, we can use MyExample (or any other name) instead of IExample in

Code: [Select]

TYPE MyExample EXTENDS Afx_IUnknown
   ' // Adequate for use with other languages that won't understand our CBSTR class
   DECLARE ABSTRACT SUB SetString (BYVAL bs AS AFX_BSTR)
   DECLARE ABSTRACT FUNCTION GetString () AS AFX_BSTR
   ' / ------------------------------------------------
   DECLARE ABSTRACT PROPERTY MyCBStr (BYREF cbs AS CBSTR)
   DECLARE ABSTRACT PROPERTY MyCBStr () AS CBSTR
   DECLARE ABSTRACT PROPERTY MyCWStr (BYREF cws AS CWSTR)
   DECLARE ABSTRACT PROPERTY MyCWStr () AS CWSTR
   DECLARE ABSTRACT PROPERTY MyCVar (BYREF cv AS CVAR)
   DECLARE ABSTRACT PROPERTY MyCVar () AS CVAR
   DECLARE ABSTRACT PROPERTY MyNumber (BYVAL num AS DOUBLE)
   DECLARE ABSTRACT PROPERTY MyNumber () AS DOUBLE
END TYPE

and then use

Code: [Select]

DIM pExample AS MyExample PTR = AfxNewCom(wszLibName, CLSID_IExample, IID_IExample)

instead of

Code: [Select]

DIM pExample AS IExample PTR = AfxNewCom(wszLibName, CLSID_IExample, IID_IExample)

This is great to avoid conflict names. Just make sure when writing a new COM class of using unique GUIDs. Paul has just posted a tool for his editor to generate GUIDs.

The names of the methods and properties can also be changed, but not its position in the list, that the compiler uses to calculate its offset in the virtual table.

Also in the DLL, we can use

Code: [Select]

TYPE IExample EXTENDS OBJECT

instead of

Code: [Select]

TYPE IExample EXTENDS Afx_IUnknown

(I have modified it in the template code posted in reply #40)

but keep TYPE IExample EXTENDS Afx_IUnknown in the declaration of the abstract method in the test code.

Instead of EXTENDS Afx_IUnknown you can also use EXTENDS OBJECT if you include the QueryInterface, AddRef and Release methods in the declaration.

Code: [Select]

TYPE IExample EXTENDS OBJECT
   DECLARE ABSTRACT FUNCTION QueryInterface (BYVAL riid AS CONST IID CONST PTR, BYVAL ppvObj AS ANY PTR PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION AddRef () AS ULONG
   DECLARE ABSTRACT FUNCTION Release () AS ULONG
   ' // Adequate for use with other languages that won't understand our CBSTR class
   DECLARE ABSTRACT SUB SetString (BYVAL bs AS AFX_BSTR)
   DECLARE ABSTRACT FUNCTION GetString () AS AFX_BSTR
   ' / ------------------------------------------------
   DECLARE ABSTRACT PROPERTY MyCBStr (BYREF cbs AS CBSTR)
   DECLARE ABSTRACT PROPERTY MyCBStr () AS CBSTR
   DECLARE ABSTRACT PROPERTY MyCWStr (BYREF cws AS CWSTR)
   DECLARE ABSTRACT PROPERTY MyCWStr () AS CWSTR
   DECLARE ABSTRACT PROPERTY MyCVar (BYREF cv AS CVAR)
   DECLARE ABSTRACT PROPERTY MyCVar () AS CVAR
   DECLARE ABSTRACT PROPERTY MyNumber (BYVAL num AS DOUBLE)
   DECLARE ABSTRACT PROPERTY MyNumber () AS DOUBLE
END TYPE

Therefore, the easiest way of making the declares to use the COM DLL is to copy the declares of the class and change VIRTUAL to ABSTRACT.

[Marc Pons]

Jose and Paul

sorry, to "disturbe" that subject

my input was more general creation/usage of dll  , just to say :

if you need  a dedicated dllmain , it is possible to do it quite simple , to give a precision to  that :

Please note that I'm not using DllMain or LibMain in the DLL because apparently it does not work, so I'm using the constructor and destructor of the module instead.

See this thread: http://www.freebasic.net/forum/viewtopic.php?t=15690

and also to say, it not always needed these    libXXX.dll.a  to use dll functions
and give some precisions too

but probably it could be placed in a different topic...

Paul , if you think so ( and estimate useful) , please change to different topic.

thanks again Jose for your precious job, 
and Paul for your superb tools  (editor, and Firefly for FB, you i'm using it again)

Marc