Print

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

[José Roca]

Is there anything in PowerBasic that we still can't do using FreeBasic?  (maybe working with, or interfacing to, DLL's is easier in PB)

Jose's library makes it so easy to program Windows in 32 and 64 bit.

One of the big selling points of PowerBASIC in my opinion is the ease to create COM servers.

James

You must be the only one using this feature. I don't know of any other user writing COM servers with PB. Any example of a COM server written with PB?

[José Roca]

Well, I have translated this example to Free Basic:

COM in plain C: https://www.codeproject.com/Articles/13601/COM-in-plain-C

Just to know what are the minimal requirements.

C++ examples use ATL, wizards, etc., and you get lost in a lot of messy 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"

' // Our IExample object's GUID
' // {6899A2A3-405B-44d4-A415-E0 8C EE 2A 97 CB}
DIM SHARED 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 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
STATIC SHARED OutstandingObjects AS DWORD

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

' ========================================================================================
' IExample object
' ========================================================================================

TYPE IExampleVtbl_ As IExampleVtbl
TYPE IExample
   lpvtbl AS IExampleVtbl_ Ptr
   ' // Additional variables
   count AS DWORD
   buffer AS WSTRING * 80
END TYPE

TYPE IExampleVTbl
   ' Functions for the IUnknown Interface
   QueryInterface AS FUNCTION (BYVAL pthis AS IExample PTR, BYVAL vTableGuid AS CONST IID CONST PTR, BYVAL ppv AS ANY PTR PTR) AS HRESULT
   AddRef AS FUNCTION (BYVAL pthis AS IExample PTR) AS ULONG
   Release AS FUNCTION (BYVAL pthis AS IExample PTR) AS ULONG
   ' Our functions
   SetString AS Function (BYVAL pthis AS IExample PTR, BYVAL pwsz AS WSTRING PTR) AS HRESULT
   GetString AS FUNCTION (BYVAL pthis AS IExample PTR, BYVAL pbuffer AS WSTRING PTR, BYVAL cch AS DWORD) AS HRESULT
END TYPE

' ========================================================================================
' IExample methods
' ========================================================================================

' // IExample's QueryInterface()
FUNCTION QueryInterface (BYVAL pthis AS IExample PTR, BYVAL vTableGuid AS CONST IID CONST PTR, BYVAL ppv AS ANY PTR PTR) AS HRESULT
   ' // Check if the GUID matches IExample VTable's GUID. We gave the C variable name
   ' // IID_IExample to our VTable GUID. We can use an OLE function called
   ' // IsEqualIID to do the comparison for us. Also, if the caller passed a
   ' // IUnknown GUID, then we'll likewise return the IExample, since it can
   ' // masquerade as an IUnknown object too
   IF IsEqualIID(vTableGuid, @IID_IUnknown) = FALSE AND IsEqualIID(vTableGuid, @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.
      *ppv = 0
      RETURN E_NOINTERFACE
   END IF

   ' // Fill in the caller's handle
   *ppv = pthis

   ' // Increment the count of callers who have an outstanding pointer to this object
   pthis->lpVtbl->AddRef(pthis)

   RETURN NOERROR
END FUNCTION

' // IExample's AddRef()
FUNCTION AddRef(BYVAL pthis AS IExample PTR) AS ULONG
   ' // Increment IExample's reference count, and return the updated value.
   ' // NOTE: We have to typecast to gain access to any data members. These
   ' // members are not defined in our .H file (so that an app can't directly
   ' // access them). Rather they are defined only above in our MyRealIExample
   ' // struct. So typecast to that in order to access those data members
   pthis->count += 1
   RETURN pthis->count
END FUNCTION

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

' // IExample's SetString(). This copies the passed string to IExample's buffer
FUNCTION SetString (BYVAL pthis AS IExample PTR, BYVAL pwsz AS WSTRING PTR) AS HRESULT
   ' // Make sure that caller passed a buffer
   IF pwsz = NULL THEN RETURN E_POINTER
   ' // Copy the passed str to IExample's buffer
   pthis->buffer = *pwsz
   RETURN NOERROR
END FUNCTION

' // IExample's GetString(). This retrieves IExample's buffer,
' // and stores its contents in a buffer passed by the caller
FUNCTION GetString(BYVAL pthis AS IExample PTR, BYVAL pbuffer AS WSTRING PTR, BYVAL cch AS DWORD) AS HRESULT
   ' // Make sure that caller passed a buffer
   IF pbuffer = NULL THEN RETURN E_POINTER
   IF cch THEN
      ' // Let's copy IExample's buffer to the passed buffer
      IF cch > 79 THEN cch = 79
      memcpy(pbuffer, @pthis->buffer, cch)
   END IF
   RETURN NOERROR
END FUNCTION

' // Here's IExample's VTable. It never changes so we can declare it static
STATIC SHARED IExample_Vtbl AS IExampleVtbl = TYPE(@QueryInterface, @AddRef, @Release, _
   @SetString, @GetString)

' ========================================================================================
' // 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 vTableGuid AS CONST IID CONST PTR, BYVAL objHandle AS ANY PTR PTR) AS HRESULT

   DIM hr AS HRESULT
   DIM thisObj AS IExample PTR

   ' // 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 IExample object
   thisObj = GlobalAlloc(GMEM_FIXED, SIZEOF(IExample))
   IF thisObj = NULL THEN RETURN E_OUTOFMEMORY
   ' // Store IExample's VTable in the object
   thisobj->lpVtbl = @IExample_Vtbl
   ' // Increment the reference count so we can call Release() below and
   '  // it will deallocate only if there is an error with QueryInterface()
   thisobj->count = 1
   ' // Initialize any other members we added to the IExample. We added
   ' // a buffer member
   thisobj->buffer = ""
   ' // Fill in the caller's handle with a pointer to the IExample we just
   ' // allocated above. We'll let IExample's QueryInterface 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->lpVtbl->QueryInterface(thisobj, vTableGuid, 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->lpVtbl->Release(thisobj)
   ' // 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 IExample GUID. That's the
   ' // only object our DLL implements
   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 and destructor of the module
' ========================================================================================
SUB ctor () CONSTRUCTOR
   OutputDebugString "DLL loaded"
   ' // Clear static counts
   OutstandingObjects = 0
   LockCount = 0
   ' // Initialize my IClassFactory with the pointer to its VTable
   MyIClassFactoryObj.lpVtbl = @MyClassFactoryVTbl
END SUB

SUB dtor () DESTRUCTOR
    OutputDebugString "DLL unloaded"
END SUB
' ========================================================================================

You must compile it as a DLL with the -dll switch.

This is a test using one of my overloaded AfxNewCom functions that allows to use the server without having to register it.

Code: [Select]

'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "windows.bi"
#include once "win/ocidl.bi"
#include once "Afx/AfxCOM.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 As IExample_
TYPE IExampleVTbl
   ' Functions for the IUnknown Interface
   QueryInterface AS FUNCTION (BYVAL pthis AS IExample PTR, BYVAL vTableGuid AS CONST IID CONST PTR, BYVAL ppv AS ANY PTR PTR) AS HRESULT
   AddRef AS FUNCTION (BYVAL pthis AS IExample PTR) AS HRESULT
   Release AS FUNCTION (BYVAL pthis AS IExample PTR) AS HRESULT
   ' Our functions
   SetString AS Function (BYVAL pthis AS IExample PTR, BYVAL pwsz AS WSTRING PTR) AS HRESULT
   GetString AS FUNCTION (BYVAL pthis AS IExample PTR, BYVAL pbuffer AS WSTRING PTR, BYVAL cch AS DWORD) AS HRESULT
END TYPE

TYPE IExample_
   lpVtbl as IExampleVTbl PTR
END TYPE

' // Initialize the COM library
CoInitialize NULL

DIM wszLibName AS WSTRING * MAX_PATH = ExePath & "\IExample.dll"
DIM pExample AS IExample PTR = AfxNewCom(wszLibName, CLSID_IExample, IID_IExample)
print "pExample = ", pExample
IF pExample THEN
   DIM hr AS HRESULT
   hr = pExample->lpvtbl->SetString(pExample, "Jose Roca")
   IF hr THEN print "hr = ", HEX(hr, 8)
   DIM wsz AS WSTRING * 80
   hr = pExample->lpvtbl->GetString(pExample, @wsz, SIZEOF(wsz))
   IF hr THEN print "hr = ", HEX(hr, 8)
   PRINT wsz
END IF
AfxSafeRelease(pExample)

' // Uninitialize the COM library
CoUninitialize

PRINT
PRINT "Press any key..."
SLEEP

and it works.

[José Roca]

Now it is a matter of seeing if the task can be simplified, if we can use a Free Basic class instead of a plain virtual table, etc.

I'm only interested in low-level COM servers. I don't plan to get involved in the nasty business of creating OCXs, type libraries, etc.

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

Also note that if we only use COM and don't add to the DLL other exported functions that we wish to call, we don't need to use the generated import library.

[José Roca]

The test example using abstract methods:

Code: [Select]

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

' // 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
   DECLARE ABSTRACT FUNCTION SetString (BYVAL pwsz AS WSTRING PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION GetString (BYVAL pbuffer AS WSTRING PTR, BYVAL cch AS DWORD) AS HRESULT
END TYPE

' // Initialize the COM library
CoInitialize NULL

DIM wszLibName AS WSTRING * MAX_PATH = ExePath & "\IExample.dll"
DIM pExample AS IExample PTR = AfxNewCom(wszLibName, CLSID_IExample, IID_IExample)
print "pExample = ", pExample
IF pExample THEN
   DIM hr AS HRESULT
   hr = pExample->SetString("Jose Roca")
   IF hr THEN print "hr = ", HEX(hr, 8)
   DIM wsz AS WSTRING * 80
   hr = pExample->GetString(@wsz, SIZEOF(wsz))
   IF hr THEN print "hr = ", HEX(hr, 8)
   PRINT wsz
END IF
AfxSafeRelease(pExample)

' // Uninitialize the COM library
CoUninitialize

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

Examples of use with PowerBASIC (32-bit only)

Inheriting from IUnknown:

Code: [Select]

#INCLUDE ONCE "windows.inc"

$CLSID_IExample = GUID$("{6899A2A3-405B-44D4-A415-E08CEE2A97CB}")
$IID_IExample = GUID$("{74666CAC-C2B1-4FA8-A049-97F3214802F0}")

INTERFACE IExample $IID_IExample : INHERIT IUnknown
   METHOD SetString (BYREF pwsz AS WSTRINGZ) AS LONG
   METHOD GetString (BYREF pbuffer AS WSTRINGZ, BYVAL cch AS DWORD) AS LONG
END INTERFACE

FUNCTION PBMAIN

DIM LibName AS STRING
LibName = Exe.Path$ & "IExample.dll"
DIM pExample AS IExample
pExample = NEWCOM CLSID $CLSID_IExample LIB LibName
IF ISOBJECT(pExample) THEN
   DIM hr AS LONG
   hr = pExample.SetString("Jose Roca")
   IF hr THEN print "hr = ", HEX$(hr, 8)
   DIM wsz AS WSTRINGZ * 80
   hr = pExample.GetString(wsz, SIZEOF(wsz))
   IF hr THEN print "hr = ", HEX$(hr, 8)
   PRINT wsz
END IF

PRINT
PRINT "Press any key..."
WAITKEY$

END FUNCTION

Inheriting from IAutomation:

Code: [Select]

#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "Ole2utils.inc"

$CLSID_IExample = GUID$("{6899A2A3-405B-44D4-A415-E08CEE2A97CB}")
$IID_IExample = GUID$("{74666CAC-C2B1-4FA8-A049-97F3214802F0}")

INTERFACE IExample $IID_IExample : INHERIT IAutomation
   METHOD SetString (BYREF pwsz AS WSTRINGZ)
   METHOD GetString (BYREF pbuffer AS WSTRINGZ, BYVAL cch AS DWORD)
END INTERFACE

FUNCTION PBMAIN

DIM LibName AS STRING
LibName = Exe.Path$ & "IExample.dll"
DIM pExample AS IExample
pExample = NEWCOM CLSID $CLSID_IExample LIB LibName
IF ISOBJECT(pExample) THEN
   TRY
      pExample.SetString("Jose Roca")
      DIM wsz AS WSTRINGZ * 80
      pExample.GetString(wsz, SIZEOF(wsz))
      PRINT wsz
   CATCH
      PRINT HEX$(OBJRESULT, 8)
   END TRY
END IF

PRINT
PRINT "Press any key..."
WAITKEY$

END FUNCTION

Therefore, FB can be used to write COM servers that work with PB and viceversa. After all, COM is a binary standard. The problem with PB is that it is 32-bit only; otherwise, probably I never would have tried FB.

[José Roca]

I have managed to use a class using virtual methods.

Code: [Select]

' ========================================================================================
' IExample object
' ========================================================================================
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
' ========================================================================================

This means that we can use all kind of data types, even CWSTR, CBSTR, etc., to store the data.

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"

' // Our IExample object's GUID
' // {6899A2A3-405B-44d4-A415-E0 8C EE 2A 97 CB}
DIM SHARED 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 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
STATIC SHARED OutstandingObjects AS DWORD

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

' ========================================================================================
' IExample object
' ========================================================================================
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
' ========================================================================================

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

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

' ========================================================================================
' IExample's QueryInterface
' ========================================================================================
FUNCTION IExample.QueryInterface (BYVAL vTableGuid AS CONST IID CONST PTR, BYVAL ppv AS ANY PTR PTR) AS HRESULT
   ' // Check if the GUID matches IExample VTable's GUID. We gave the C variable name
   ' // IID_IExample to our VTable GUID. We can use an OLE function called
   ' // IsEqualIID to do the comparison for us. Also, if the caller passed a
   ' // IUnknown GUID, then we'll likewise return the IExample, since it can
   ' // masquerade as an IUnknown object too
   IF IsEqualIID(vTableGuid, @IID_IUnknown) = FALSE AND IsEqualIID(vTableGuid, @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.
      *ppv = 0
      RETURN E_NOINTERFACE
   END IF
   ' // Fill in the caller's handle
   *ppv = @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.
   ' // NOTE: We have to typecast to gain access to any data members. These
   ' // members are not defined in our .H file (so that an app can't directly
   ' // access them). Rather they are defined only above in our MyRealIExample
   ' // struct. So typecast to that in order to access those data members
   this.count += 1
   RETURN this.count
END FUNCTION
' ========================================================================================

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

' ========================================================================================
' IExample's SetString
' This copies the passed string to IExample's buffer
' ========================================================================================
FUNCTION IExample.SetString (BYVAL pwsz AS WSTRING PTR) AS HRESULT
   ' // Make sure that caller passed a buffer
   IF pwsz = NULL THEN RETURN E_POINTER
   ' // Copy the passed str to IExample's buffer
   this.buffer = *pwsz
   RETURN NOERROR
END FUNCTION
' ========================================================================================

' ========================================================================================
' IExample's GetString
' This retrieves IExample's buffer and stores its contents in a buffer passed by the caller.
' ========================================================================================
FUNCTION IExample.GetString (BYVAL pbuffer AS WSTRING PTR, BYVAL cch AS DWORD) AS HRESULT
   ' // Make sure that caller passed a buffer
   IF pbuffer = NULL THEN RETURN E_POINTER
   IF cch THEN
      ' // Let's copy IExample's buffer to the passed buffer
      IF cch > 79 THEN cch = 79
      memcpy(pbuffer, @this.buffer, cch)
   END IF
   RETURN NOERROR
END FUNCTION
' ========================================================================================

' ========================================================================================
' // 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 vTableGuid 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 IExample object
   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->count = 1
   ' // Initialize any other members we added to the IExample. We added
   ' // a buffer member
   thisobj->buffer = ""
   ' // Fill in the caller's handle with a pointer to the IExample we just
   ' // allocated above. We'll let IExample's QueryInterface 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(vTableGuid, 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 IExample GUID. That's the
   ' // only object our DLL implements
   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
   OutputDebugString "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
    OutputDebugString "DLL unloaded"
END SUB
' ========================================================================================

Test example, using ABSTRACT methods:

Code: [Select]

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

' // 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
   DECLARE ABSTRACT FUNCTION SetString (BYVAL pwsz AS WSTRING PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION GetString (BYVAL pbuffer AS WSTRING PTR, BYVAL cch AS DWORD) AS HRESULT
END TYPE

' // Initialize the COM library
CoInitialize NULL

DIM wszLibName AS WSTRING * MAX_PATH = ExePath & "\IExample2.dll"
DIM pExample AS IExample PTR = AfxNewCom(wszLibName, CLSID_IExample, IID_IExample)
print "pExample = ", pExample
IF pExample THEN
   DIM hr AS HRESULT
   hr = pExample->SetString("Jose Roca")
   IF hr THEN print "hr = ", HEX(hr, 8)
   DIM wsz AS WSTRING * 80
   hr = pExample->GetString(@wsz, SIZEOF(wsz))
   IF hr THEN print "hr = ", HEX(hr, 8)
   PRINT wsz
END IF
AfxSafeRelease(pExample)

' // Uninitialize the COM library
CoUninitialize

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

Looks like we are going to have a good alternative to ordinary DLLs

As you can see, low-level COM servers have very little overhead. Just the IClassFactory object and the DllGetClassObject/DllCanUnloadNow functions.

Code: [Select]

' ========================================================================================
' // 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 vTableGuid AS CONST IID CONST PTR, BYVAL objHandle AS ANY PTR PTR) AS HRESULT

   DIM hr AS HRESULT
   DIM thisObj AS IExample PTR

   ' // 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 IExample object
''   thisObj = GlobalAlloc(GMEM_FIXED, SIZEOF(IExample))
''   IF thisObj = NULL THEN RETURN E_OUTOFMEMORY
   ' // Store IExample's VTable in the object
   thisobj = 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->count = 1
   ' // Initialize any other members we added to the IExample. We added
   ' // a buffer member
   thisobj->buffer = ""
   ' // Fill in the caller's handle with a pointer to the IExample we just
   ' // allocated above. We'll let IExample's QueryInterface 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(vTableGuid, 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 IExample GUID. That's the
   ' // only object our DLL implements
   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

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


[José Roca]

A further improvement would be to also use a class with virtual methods for the class factory and put it in an include file. The DllGetClassObject will create an instance of the IExample class, pass it to the class factory class and call its QueryInterface method. This way, we won't have to change the class factory when writing new COM DLLs and will also allow to have more than one interface implemented. The constructor of the module can create an instance of the class factory and the destructor delete it. Promising

For events, we can implement a method to set a pointer to a callback funtion and send the events to that function. This is what the low-level COM servers do. I'm sorry (or maybe not) for the lovers of Automation languages, but I hate dispatch interfaces and events. A low-level COM server is as efficient as an ordinary DLL and can work with all kind of data types. VB6 can't use them, but it is dead and buried.

[José Roca]

Another advantage of low-level COM servers is that we can use them to create custom controls that can be added to a GUI without having to use an OLE Container, contrarily to these nasty OCXs. We only need to pass the handle of the parent window and they will work just like any other custom control implemented in a DLL or an include file. Another advantage of SDK over DDT.

[Paul Squires]

Wow, now this is very exciting stuff! I can't wait to try it when I get home. I am itching here wanting to download, compile and experiment! 

[José Roca]

Meanwhile, because I have become distracted by a post in the FB forum about finding occurrences of a substring (tally), I have made a test that will become an alternative tor PB's FILESCAN, but mine is faster

Code: [Select]

#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "crt/string.bi"

' --> change the path
DIM wszFileName AS WSTRING * MAX_PATH = $"C:\Users\Pepe\FreeBasic64\inc\win\mshtmlc.bi"
DIM bSuccess AS LONG, dwFileSize AS DWORD, dwHighSize AS DWORD, dwBytesRead AS DWORD
DIM nCount AS DWORD
DIM hFile AS HANDLE = CreateFileW(@wszFileName, GENERIC_READ, FILE_SHARE_READ, NULL, _
                      OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL)
IF hFile = INVALID_HANDLE_VALUE THEN END
' // Get the size of the file
dwFileSize = GetFileSize(hFile, @dwHighSize)
IF dwHighSize THEN
   CloseHandle(hFile)
   END
END IF
DIM pBuffer AS UBYTE PTR
pBuffer = CAllocate(1, dwFileSize)
bSuccess = ReadFile(hFile, pBuffer, dwFileSize, @dwBytesRead, NULL)
CloseHandle(hFile)
IF bSuccess THEN
   IF pBuffer THEN
      DIM pstr AS ANY PTR = pBuffer
      DIM sf AS ZSTRING * 3 = CHR(13, 10)
      DIM t1 AS DOUBLE = TIMER
      DO
         pstr = strstr(pstr, sf)
         IF pstr = NULL THEN EXIT DO
         pstr += 2
         nCount += 1
      LOOP
      DIM t2 AS DOUBLE = TIMER
      PRINT "seconds: ", t2 - t1
      DeAllocate(pBuffer)
   END IF
END IF

print "Count: ", nCount

PRINT
PRINT "Press any key..."
SLEEP

Count: 24974
Seconds: 0.002644868538482115


PowerBASIC FILESCAN:

Code: [Select]

#COMPILE CON
#DIM ALL

FUNCTION PBMAIN () AS LONG

   OPEN "C:\Users\Pepe\FreeBasic64\inc\win\mshtmlc.bi" FOR INPUT AS #1
   LOCAL t1, t2 AS DOUBLE, count AS LONG
   t1 = TIMER
   FILESCAN #1, RECORDS TO count
   t2 = TIMER
   CLOSE #1
   PRINT "Count:", count
   PRINT "Seconds: ", STR$(t2 - t1, 18)
   WAITKEY$

END FUNCTION

Count: 24974
Seconds: .016000000003259629

With this function I will retrieve the number of lines and I will allocate a 1D dimensional safe array with number of lines elements, that I will fill with calls to strtok. These C functions are speed demons because they use pointers.

[José Roca]

Wow, now this is very exciting stuff! I can't wait to try it when I get home. I am itching here wanting to download, compile and experiment! 

For some reason, many people find COM very hard to understand, yet I find it very straightforward. In the PB world, only Dominic and I have mastered it. Dominic knows more than I about Automation, in part because Automation has never interested too much to me and in part because he is a more skilled Windows programmer than I. The first thing that they don't undestand is that COM is not OOP (I began to use it with PB using CALL DWORD!) and that classes are used for convenience, but its use is not mandatory at all. This confusion has led to many people to buy books about OOP programming to understand COM! Poor guys...

Another big confusion is the belief that it is slow and bloated, and mention VB6 and the infamous OCXs. As you can see, using low-level COM the bloat won't be bigger than 2 KB, the speed will be the same that a standard DLL, and you aren't forced to use VARIANTs, safe arrays and BSTR. You can use any kind of data type, including UDTs, as with any other procedure.

In the beginning it was low-level COM, then came the VB6 designers and spoiled it all with Automation. Microsoft writes almost all of its COM servers using low-level COM (except Office), then they wrote Automation wrappers for VB6 and now for .NET. Automation has its use for scripting languages, but it is an speed killer.

[Paul Squires]

Another big confusion is the belief that it is slow and bloated, and mention VB6 and the infamous OCXs. As you can see, using low-level COM the bloat won't be bigger than 2 KB, the speed will be the same that a standard DLL, and you aren't forced to use VARIANTs, safe arrays and BSTR. You can use any kind of data type, including UDTs, as with any other procedure.

I admit, until a few short years ago, I was guilty of believing this as well. Slow and bloated.

[Paul Squires]

A further improvement would be to also use a class with virtual methods for the class factory and put it in an include file. The DllGetClassObject will create an instance of the IExample class, pass it to the class factory class and call its QueryInterface method. This way, we won't have to change the class factory when writing new COM DLLs and will also allow to have more than one interface implemented. The constructor of the module can create an instance of the class factory and the destructor delete it. Promising

I just finished working through the examples and was able to easily create the COM dll and call it successfully. No problems at all. I then started to learn the sequence of the code in the dll and the use of IUnknown and IClassFactory. It is pretty cool how you simplified the code as your examples progressed simply by using EXTENDS and the virtual and abstract functions. I like the idea you describe above for simplifying the handling of IClassFactory.

For events, we can implement a method to set a pointer to a callback funtion and send the events to that function. This is what the low-level COM servers do. I'm sorry (or maybe not) for the lovers of Automation languages, but I hate dispatch interfaces and events. A low-level COM server is as efficient as an ordinary DLL and can work with all kind of data types. VB6 can't use them, but it is dead and buried.

Ah yes, handling events. Simply set a pointer to a callback function. Easy and efficient.

I must say, the whole world of COM with all of its different terminology can be intimidating at first but once you break it all down to the basic parts then it all seems to make sense and is no more difficult to understand conceptually than any other programming concept. Have you found some type of simple basic primer on the topic that we can post here so people new to the subject can wrap their heads around the concepts? I will search for some and post.

...and you aren't forced to use VARIANTs, safe arrays and BSTR. You can use any kind of data type, including UDTs, as with any other procedure.

That was always a hangup I had with COM automation, having to mangle your data into safe data structures for use with Automation. With your low level COM servers, being able to use native data types is an incredibly better, easier, and faster freedom.

Maybe we should have a simple tool that creates the GUIDs? Maybe an external user tool for WinFBE?

You have done an incredible job on this. Simply incredible. Fast, small, dll's without having to use an import library.

[José Roca]

> Maybe we should have a simple tool that creates the GUIDs? Maybe an external user tool for WinFBE?

There is not need for a tool. Calling the AfxGuid function (in AfxCOM.inc) generates a unique guid, and AfxGuidText(guid) returns it as human readable text. In my editor, if you press Ctrl+Alt+G, it inserts the guid in the cursor position. The only problem is that as in FB a GUID is not a data type but an structure, instead of "{6899A2A3-405B-44d4-A415-E08CEE2A97CB}" it uses CLSID_IExample AS GUID = TYPE(&h6899A2A3, &h405B, &h44D4, {&hA4, &h15, &hE0, &h8C, &hEE, &h2A, &h97, &hCB}). Maybe an small dialog with two edit text boxes and when you press a "Generate button" display the new guid in the two formats? Or two different hot keys?