PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: [1] 2 3 ... 10
 1 
 on: Today at 09:49:42 AM 
Started by Josť Roca - Last post by 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.

 2 
 on: Today at 09:17:05 AM 
Started by Josť Roca - Last post by 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 for 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.

 3 
 on: Today at 09:07:33 AM 
Started by Josť Roca - Last post by TechSupport
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!  :)

 4 
 on: Today at 05:31:48 AM 
Started by Josť Roca - Last post by 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.

 5 
 on: Today at 05:06:07 AM 
Started by Josť Roca - Last post by 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.

 6 
 on: Today at 04:24:18 AM 
Started by Josť Roca - Last post by 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

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

 7 
 on: Today at 04:12:29 AM 
Started by Josť Roca - Last post by 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("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

 8 
 on: Today at 02:28:30 AM 
Started by Josť Roca - Last post by 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("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.

 9 
 on: Today at 01:53:02 AM 
Started by Josť Roca - Last post by 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("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

 10 
 on: Today at 12:06:57 AM 
Started by Josť Roca - Last post by 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.

Pages: [1] 2 3 ... 10