PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: 1 [2] 3 4 ... 11

Author Topic: CWindow Release Candidate 31  (Read 2263 times)

Johan Klassen

  • FireFly3 Registered User
  • Little Newbie FireFly
  • *
  • Posts: 19
  • FF3 User
Re: CWindow Release Candidate 31
« Reply #15 on: August 14, 2017, 04:44:57 PM »

thank you Josť Roca for the help file  :)
Logged

Paul Squires

  • Administrator
  • Master FireFly Member
  • *****
  • Posts: 8090
  • Windows 10
    • PlanetSquires Software
Re: CWindow Release Candidate 31
« Reply #16 on: August 14, 2017, 06:21:56 PM »

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.

Logged
Paul Squires
PlanetSquires Software
FireFly Visual Designer, WinFBE Editor

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #17 on: August 15, 2017, 12:43:14 AM »

> Is there anything in PowerBasic that we still can't do using FreeBasic?

There is not much left. And the alternatives offered by the framework are superior.

I'm going to add this small class:

Code: [Select]
' ========================================================================================
' CComPtr class
' ========================================================================================
TYPE CComPtr
   m_pUnk AS IUnknown PTR
   DECLARE CONSTRUCTOR (BYVAL pUnk AS ANY PTR, BYVAL fAddRef AS BOOLEAN = FALSE)
   DECLARE DESTRUCTOR
   DECLARE OPERATOR Let (BYVAL pUnk AS ANY PTR)
END TYPE
' ========================================================================================
' ========================================================================================
PRIVATE CONSTRUCTOR CComPtr (BYVAL pUnk AS ANY PTR, BYVAL fAddRef AS BOOLEAN = FALSE)
   m_pUnk = pUnk
   IF fAddRef THEN AfxSafeAddRef(m_pUnk)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
PRIVATE DESTRUCTOR CComPtr
   AfxSafeRelease(m_pUnk)
END DESTRUCTOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR CComPtr.Let (BYVAL pUnk AS ANY PTR)
   AfxSafeRelease(m_pUnk)
   m_pUnk= pUnk
END OPERATOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR * (BYREF _ccomptr AS CComPtr) AS ANY PTR
   OPERATOR = _ccomptr.m_pUnk
END OPERATOR
' ========================================================================================

When working with COM we can assign COM pointers to instances of this class and we no longer have to worry about releasing them.
« Last Edit: August 15, 2017, 01:11:32 AM by Josť Roca »
Logged

James Fuller

  • FireFly3 Registered User
  • Senior FireFly Member
  • *
  • Posts: 272
  • FF3 User
Re: CWindow Release Candidate 31
« Reply #18 on: August 15, 2017, 06:44:33 AM »

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
Logged

aloberr

  • FireFly3 User
  • Little Newbie FireFly
  • *
  • Posts: 33
Re: CWindow Release Candidate 31
« Reply #19 on: August 15, 2017, 08:36:42 AM »

COM servers can be easy with the use of the virtual classes, that will be more with the concepts of interface or/and  multiples inheritance that FB do not have yet.
Logged

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #20 on: August 15, 2017, 03:45:14 PM »

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?
« Last Edit: August 15, 2017, 03:46:50 PM by Josť Roca »
Logged

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #21 on: August 15, 2017, 11:59:28 PM »

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, "Josť 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.
« Last Edit: August 16, 2017, 02:56:34 AM by Josť Roca »
Logged

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #22 on: August 16, 2017, 12:06:57 AM »

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.
« Last Edit: August 16, 2017, 02:54:33 AM by Josť Roca »
Logged

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #23 on: August 16, 2017, 01:53:02 AM »

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("Josť 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

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #24 on: August 16, 2017, 02:28:30 AM »

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("Josť 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("Josť 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.
« Last Edit: August 16, 2017, 03:00:23 AM by Josť Roca »
Logged

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #25 on: August 16, 2017, 04:12:29 AM »

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("Josť 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
« Last Edit: August 16, 2017, 04:34:59 AM by Josť Roca »
Logged

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #26 on: August 16, 2017, 04:24:18 AM »

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

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #27 on: August 16, 2017, 05:06:07 AM »

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.
« Last Edit: August 16, 2017, 05:40:09 AM by Josť Roca »
Logged

Josť Roca

  • Moderator
  • Master FireFly Member
  • *****
  • Posts: 2735
    • Josť Roca Software
Re: CWindow Release Candidate 31
« Reply #28 on: August 16, 2017, 05:31:48 AM »

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.
« Last Edit: August 16, 2017, 05:33:22 AM by Josť Roca »
Logged

Paul Squires

  • Administrator
  • Master FireFly Member
  • *****
  • Posts: 8090
  • Windows 10
    • PlanetSquires Software
Re: CWindow Release Candidate 31
« Reply #29 on: August 16, 2017, 09:07:33 AM »

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!  :)
Logged
Paul Squires
PlanetSquires Software
FireFly Visual Designer, WinFBE Editor
Pages: 1 [2] 3 4 ... 11