Code: Select all
'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "windows.bi"
#include once "win/ocidl.bi"
'#include once "Afx/AfxCOM.inc"
DECLARE FUNCTION AfxSafeRelease (BYREF pv AS ANY PTR) AS ULONG
DECLARE FUNCTION AfxNewCom OVERLOAD (BYREF wszLibName AS CONST WSTRING, BYREF rclsid AS CONST CLSID, BYREF riid AS CONST IID, BYREF wszLicKey AS WSTRING = "") AS ANY PTR
' // 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 OBJECT
' Methods of the IUnknown Interface
DECLARE ABSTRACT FUNCTION QueryInterface (BYVAL vTableGuid AS CONST IID CONST PTR, BYVAL ppv AS ANY PTR PTR) AS HRESULT
DECLARE ABSTRACT FUNCTION AddRef () AS ULONG
DECLARE ABSTRACT FUNCTION Release () AS ULONG
' Our methods
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_template_01.dll"
DIM pExample AS IExample PTR = AfxNewCom(wszLibName, CLSID_IExample, IID_IExample)
IF pExample THEN
DIM hr AS HRESULT
hr = pExample->SetString("José Roca")
DIM wsz AS WSTRING * 80
hr = pExample->GetString(@wsz, SIZEOF(wsz))
PRINT wsz
END IF
AfxSafeRelease(pExample)
' // Uninitialize the COM library
CoUninitialize
' // Functions extracted from my WinFBX framework //
' ========================================================================================
' Decrements the reference count for an interface on an object.
' The function returns the new reference count. This value is intended to be used only
' for test purposes.
' When the reference count on an object reaches zero, Release must cause the interface
' pointer to free itself. When the released pointer is the only existing reference to an
' object (whether the object supports single or multiple interfaces), the implementation
' must free the object.
' ========================================================================================
FUNCTION AfxSafeRelease (BYREF pv AS ANY PTR) AS ULONG
IF pv = NULL THEN RETURN 0
FUNCTION = cast(IUnknown PTR, pv)->lpvtbl->Release(pv)
pv = NULL
END FUNCTION
' ========================================================================================
' ========================================================================================
' Loads the specified library from file and creates an instance of an object.
' Parameters:
' - wszLibName = Full path where the library is located.
' - rclsid = The CLSID (class identifier) associated with the data and code that will be
' used to create the object.
' - riid = A reference to the identifier of the interface to be used to communicate with the object.
' - wszLicKey = The license key.
' If it succeeds, returns a reference to the requested interface; otherwise, it returns null.
' Not every component is a suitable candidate for use under this overloaded AfxNewCom function.
' - Only in-process servers (DLLs) are supported.
' - Components that are system components or part of the operating system, such as XML,
' Data Access, Internet Explorer, or DirectX, aren't supported
' - Components that are part of an application, such Microsoft Office, aren't supported.
' - Components intended for use as an add-in or a snap-in, such as an Office add-in or
' a control in a Web browser, aren't supported.
' - Components that manage a shared physical or virtual system resource aren't supported.
' - Visual ActiveX controls aren't supported because they need to be initilized and
' activated by the OLE container.
' Note: Do not use DyLibFree to unload the library once you have got a valid reference
' to an interface or your application will GPF. Before calling DyLibFree, all the
' interface references must be released. If you don't need to unload the library until
' the application ends, then you don't need to call DyLibFree because CoUninitialize
' closes the COM library on the current thread, unloads all DLLs loaded by the thread,
' frees any other resources that the thread maintains, and forces all RPC connections on
' the thread to close.
' ========================================================================================
FUNCTION AfxNewCom OVERLOAD (BYREF wszLibName AS CONST WSTRING, BYREF rclsid AS CONST CLSID, BYREF riid AS CONST IID, BYREF wszLicKey AS WSTRING = "") AS ANY PTR
DIM hr AS LONG, hLib AS HMODULE, pDisp AS ANY PTR
DIM pIClassFactory AS IClassFactory PTR, pIClassFactory2 AS IClassFactory2 PTR
' // See if the library is already loaded in the address space
hLib = GetModuleHandleW(wszLibName)
' // If it is not loaded, load it
IF hLib = NULL THEN hLib = LoadLibraryW(wszLibName)
' // If it fails, abort
IF hLib = NULL THEN EXIT FUNCTION
' // Retrieve the address of the exported function DllGetClassObject
DIM pfnDllGetClassObject AS FUNCTION (BYVAL rclsid AS CONST IID CONST PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL ppv AS LPVOID PTR) AS HRESULT
pfnDllGetClassObject = CAST(ANY PTR, GetProcAddress(hLib, "DllGetClassObject"))
IF pfnDllGetClassObject = NULL THEN EXIT FUNCTION
IF LEN(wszLicKey) = 0 THEN
' // Request a reference to the IClassFactory interface
hr = pfnDllGetClassObject(@rclsid, @IID_IClassFactory, @pIClassFactory)
IF hr <> S_OK THEN EXIT FUNCTION
' // Create an instance of the server or control
hr = pIClassFactory->lpVtbl->CreateInstance(pIClassFactory, NULL, @riid, @pDisp)
IF hr <> S_OK THEN
pIClassFactory->lpVtbl->Release(pIClassFactory)
EXIT FUNCTION
END IF
ELSE
' // Request a reference to the IClassFactory2 interface
hr = pfnDllGetClassObject(@rclsid, @IID_IClassFactory, @pIClassFactory2)
IF hr <> S_OK THEN EXIT FUNCTION
' // Create a licensed instance of the server or control
hr = pIClassFactory2->lpVtbl->CreateInstanceLic(pIClassFactory2, NULL, NULL, @riid, @wszLicKey, @pDisp)
IF hr <> S_OK THEN
pIClassFactory2->lpVtbl->Release(pIClassFactory2)
EXIT FUNCTION
END IF
END IF
IF pIClassFactory THEN pIClassFactory->lpVtbl->Release(pIClassFactory)
IF pIClassFactory2 THEN pIClassFactory2->lpVtbl->Release(pIClassFactory2)
RETURN pDisp
END FUNCTION
' ========================================================================================
PRINT
PRINT "Press any key..."
SLEEP