This is an issue that has been poking about in the back of my mind for some time. Its finally come to the fore. It doesn't seem to me to be a logical necessity that outgoing, i.e., event interfaces, even need to be implemented through classes. This is how its done in PowerBASIC of course, and there is a built in implementation there involving the 'As Events' clause of the class keyword. And it does appear that internally a VTable is being set up and event methods are located in a VTable (more exactly, pointers to them). But it doesn't look to me like that is any kind of necessity, because with a pure dispinterface that is an events interface, for example, from an ActiveX control, the COM object will only ever call into the seven methods of IDispatch. The events will get called by client code in the client of the ActiveX control through a dispid passed into IDispatch::Invoke(). That is the sense in which I am making this comment. What precipitated my presenting these thoughts is that I'm now writing the code for my C++ COM Browser, and I have to decide how I want to do it. Several weeks ago when I posted that C++ MSFlexGrid example of mine is when these thoughts first occurred to me. In that example I did create an events interface and inherited it into an events class in the standard COM / C++ way of doing it. But it seemed superfluous to me at the time as the COM object would never really call into that part of the VTable where the pointers to the events lived, but would instead only call into IDispatch::Invoke(). My code would receive the dispid in IDispatch::Invoke(), and then call the required event procedure using select case (switch) logic. Therefore, why not just make the event procedures simple global functions not part of any class? I'm just musing about this, but would appreciate Dominic's, Jose's or anyone's thoughts on the matter.
You are bang on, at least I think that is the phrase for being 100 percent correct.
There is no need for a vtable with the methods of the source interface. All you need
is a sink that satisfies the ActiveX control when it does its sanity check.
For example, if you were to drop the MSFlexGrid control in Phoenix 2.0, this is what you
would see generated before the methods are cracked.
'-------------------------------------------------------------------------------
'
' PROCEDURE: Form1_OleEventsHandler
' PURPOSE: Creates the Form1 OLE events handler.
' RETURNS: S_OK if successful; otherwise DISP_E_MEMBERNOTFOUND if dispatch ID
' is not in event set.
'
'-------------------------------------------------------------------------------
FUNCTION Form1_OleEventsHandler _
( _
BYVAL pThis AS DWORD, _ ' [in] automation object (IDispatch)
BYVAL lParam AS LONG, _ ' [in] application-defined value
BYVAL dispIdMember AS LONG, _ ' [in] identifies the member (dispatch ID)
riid AS GUID, _ ' [in] reserved for future use. Must be IID_NULL
BYVAL lcid AS DWORD, _ ' [in] the locale context in which to interpret arguments
BYVAL wFlags AS WORD, _ ' [in] flags describing the context of the invoke call
pDispParams AS DISPPARAMSAPI, _ ' [in,out] pointer to a structure containing an array of arguments
pVarResult AS VARIANTAPI, _ ' [out] pointer to a Variant or NULL if the caller expects no result
pExcepInfo AS EXCEPINFO, _ ' [out] pointer to an EXCEPINFO structure or NULL
puArgErr AS DWORD _ ' [out] indicates the index (within rgvarg) of the argument with incorrect type
) AS LONG
LOCAL hr AS LONG ' the return value (HRESULT)
hr = %S_OK
' lParam is defined as the handle of the OLE container
SELECT CASE GetDlgCtrlID(lParam)
CASE %IDC_FORM1_MSFLEXGRID1
SELECT CASE dispIdMember
CASE &H800100E0 ' GotFocus
Form1_MSFlexGrid1_GotFocusCP pThis, lParam, pDispParams, pVarResult
CASE &H800100E1 ' LostFocus
Form1_MSFlexGrid1_LostFocusCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA8 ' Click
Form1_MSFlexGrid1_ClickCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA6 ' KeyDown
Form1_MSFlexGrid1_KeyDownCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA7 ' DblClick
Form1_MSFlexGrid1_DblClickCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA5 ' KeyPress
Form1_MSFlexGrid1_KeyPressCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA4 ' KeyUp
Form1_MSFlexGrid1_KeyUpCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA3 ' MouseDown
Form1_MSFlexGrid1_MouseDownCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA2 ' MouseMove
Form1_MSFlexGrid1_MouseMoveCP pThis, lParam, pDispParams, pVarResult
CASE &HFFFFFDA1 ' MouseUp
Form1_MSFlexGrid1_MouseUpCP pThis, lParam, pDispParams, pVarResult
CASE &H00000045 ' SelChange
Form1_MSFlexGrid1_SelChangeCP pThis, lParam, pDispParams, pVarResult
CASE &H00000046 ' RowColChange
Form1_MSFlexGrid1_RowColChangeCP pThis, lParam, pDispParams, pVarResult
CASE &H00000047 ' EnterCell
Form1_MSFlexGrid1_EnterCellCP pThis, lParam, pDispParams, pVarResult
CASE &H00000048 ' LeaveCell
Form1_MSFlexGrid1_LeaveCellCP pThis, lParam, pDispParams, pVarResult
CASE &H00000049 ' Scroll
Form1_MSFlexGrid1_ScrollCP pThis, lParam, pDispParams, pVarResult
CASE &H0000004A ' Compare
Form1_MSFlexGrid1_CompareCP pThis, lParam, pDispParams, pVarResult
CASE &H0000060E ' OLEStartDrag
Form1_MSFlexGrid1_OLEStartDragCP pThis, lParam, pDispParams, pVarResult
CASE &H0000060F ' OLEGiveFeedback
Form1_MSFlexGrid1_OLEGiveFeedbackCP pThis, lParam, pDispParams, pVarResult
CASE &H00000610 ' OLESetData
Form1_MSFlexGrid1_OLESetDataCP pThis, lParam, pDispParams, pVarResult
CASE &H00000611 ' OLECompleteDrag
Form1_MSFlexGrid1_OLECompleteDragCP pThis, lParam, pDispParams, pVarResult
CASE &H00000612 ' OLEDragOver
Form1_MSFlexGrid1_OLEDragOverCP pThis, lParam, pDispParams, pVarResult
CASE &H00000613 ' OLEDragDrop
Form1_MSFlexGrid1_OLEDragDropCP pThis, lParam, pDispParams, pVarResult
CASE ELSE
hr = %DISP_E_MEMBERNOTFOUND
END SELECT
END SELECT
FUNCTION = hr
END FUNCTION
My headers have to include files, EventSink.inc and EventSinkEx.inc. The first one passes the data to a user defined callback function and the second one to a user defined PB class.
EventSink.inc
' ########################################################################################
' Event Sink Class
' Connects/disconnects from the events fired by a server.
' Call EV_Advise to connect events and EV_Unadvise to disconnect.
' Copyright (c) 2011 José Roca
' All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#INCLUDE THIS ONCE
%EVENTSINK_INC = 1
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "unknwn.inc"
#INCLUDE ONCE "ocidl.inc"
#INCLUDE ONCE "ole2utils.inc"
' ========================================================================================
' Callback function prototype
' ========================================================================================
DECLARE FUNCTION EV_EventsCallback ( _
BYVAL pthis AS DWORD _ ' // Pointer to the client's IDispatch
, BYVAL dispidMember AS LONG _ ' // Identifier of the event
, BYREF pdispparams AS DISPPARAMS _ ' // Structure containing an array of arguments
, BYREF pvarResult AS VARIANT _ ' // Pointer to the location where the result is to be stored, or NULL if the caller expects no result
, BYVAL pCustData AS DWORD _ ' // Pointer to user defined data
) AS LONG
' ========================================================================================
' Sample code
' ========================================================================================
'' // Connect events
'hr = EV_Advise(pObject, $IID_ObjectInterface, _
' CODEPTR(ObjectInterface_EventsCallback), 0, dwCookie)
'
'' // Disconnect events
'hr = EV_Unadvise(pObject, $IID_ObjectInterface, dwCookie)
'
'' // Events callback function
'' // Parameters in DISPPARAMS are in reversed order.
'' // The DispGetParam function can be used to extract values from DISPPARAMS.
'
'FUNCTION ObjectInterface_EventsCallback ( _
' BYVAL pthis AS DWORD _ ' // Pointer to the client's IDispatch
' , BYVAL dispidMember AS LONG _ ' // Identifier of the event
' , BYREF pdispparams AS DISPPARAMS _ ' // Structure containing an array of arguments
' , BYREF pvarResult AS VARIANT _ ' // Pointer to the location where the result is to be stored, or NULL if the caller expects no result
' , BYVAL pCustData AS DWORD _ ' // Pointer to user defined data
' ) AS LONG ' // Return value
' FUNCTION = %S_OK
' SELECT CASE AS LONG dispidMember
' CASE &H00000001 ' (1) ' // Click
' MSGBOX "Click"
' CASE ELSE
' FUNCTION = %DISP_E_MEMBERNOTFOUND
' END SELECT
'END FUNCTION
' ########################################################################################
' IConnectionPointContainer::FindConnectionPoint
' Returns a pointer to the IConnectionPoint interface of a connection point for a specified IID,
' if that IID describes a supported outgoing interface.
' ########################################################################################
FUNCTION EV_IConnectionPointContainer_FindConnectionPoint (BYVAL pthis AS DWORD PTR, BYREF riid AS GUID, BYREF ppCP AS DWORD) AS LONG
LOCAL HRESULT AS LONG
CALL DWORD @@pthis[4] USING EV_IConnectionPointContainer_FindConnectionPoint(pthis, riid, ppCP) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' IConnectionPoint::Advise
' Establishes a connection between the connection point object and the client's sink.
' ########################################################################################
FUNCTION EV_IConnectionPoint_Advise (BYVAL pthis AS DWORD PTR, BYVAL pUnkSink AS DWORD, BYREF pdwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG
CALL DWORD @@pthis[5] USING EV_IConnectionPoint_Advise(pthis, pUnkSink, pdwCookie) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' IConnectionPoint::Unadvise
' Terminates an advisory connection previously established through EV_IConnectionPoint_Advise.
' The dwCookie parameter identifies the connection to terminate.
' ########################################################################################
FUNCTION EV_IConnectionPoint_Unadvise (BYVAL pthis AS DWORD PTR, BYVAL dwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG
CALL DWORD @@pthis[6] USING EV_IConnectionPoint_Unadvise(pthis, dwCookie) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' IDispatch virtual table
' ########################################################################################
TYPE EV_IDispatchEventsVtbl
QueryInterface AS DWORD ' // Returns pointers to supported interfaces
AddRef AS DWORD ' // Increments reference count
Release AS DWORD ' // Decrements reference count
GetTypeInfoCount AS DWORD ' // Retrieves the number of type descriptions
GetTypeInfo AS DWORD ' // Retrieves a description of object's programmable interface
GetIDsOfNames AS DWORD ' // Maps name of method or property to DispId
Invoke AS DWORD ' // Calls one of the object's methods, or gets/sets one of its properties
pVtblAddr AS DWORD ' // Address of the virtual table
cRef AS DWORD ' // Reference count
pthis AS DWORD ' // IUnknown or IDispatch of the control that fires the events
pCallback AS DWORD ' // Address of the callback function
pCustData AS DWORD ' // Pointer to custom data
dwCookie AS DWORD ' // Cookie
riid AS GUID ' // GUID of the events interface
END TYPE
' ########################################################################################
' ########################################################################################
' Builds the IDispatch Virtual Table
' ########################################################################################
FUNCTION EV_IDispatchEvents_BuildVtbl (BYVAL pthis AS DWORD, BYREF riid AS GUID, BYVAL pCallback AS DWORD, BYVAL pCustData AS DWORD) AS DWORD
LOCAL pVtbl AS EV_IDispatchEventsVtbl PTR
LOCAL pUnk AS EV_IDispatchEventsVtbl PTR
pVtbl = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, SIZEOF(@pVtbl))
IF pVtbl = 0 THEN EXIT FUNCTION
@pVtbl.QueryInterface = CODEPTR(EV_IDispatchEvents_QueryInterface)
@pVtbl.AddRef = CODEPTR(EV_IDIspatchEvents_AddRef)
@pVtbl.Release = CODEPTR(EV_IDispatchEvents_Release)
@pVtbl.GetTypeInfoCount = CODEPTR(EV_EV_IDispatchEvents_GetTypeInfoCount)
@pVtbl.GetTypeInfo = CODEPTR(EV_IDispatchEvents_GetTypeInfo)
@pVtbl.GetIDsOfNames = CODEPTR(EV_IDispatchEvents_GetIDsOfNames)
@pVtbl.Invoke = CODEPTR(EV_IDispatchEvents_Invoke)
@pVtbl.pVtblAddr = pVtbl
@pVtbl.pthis = pthis
@pVtbl.riid = riid
@pVtbl.pCallback = pCallback
@pVtbl.pCustData = pCustData
pUnk = VARPTR(@pVtbl.pVtblAddr)
FUNCTION = pUnk
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT QueryInterface([in] *GUID riid, [out] **VOID ppvObj)
' Returns the IUnknown of our class and increments the reference counter.
' ########################################################################################
FUNCTION EV_IDispatchEvents_QueryInterface (BYVAL pUnkSink AS EV_IDispatchEventsVtbl PTR, _
BYREF riid AS GUID, BYREF ppvObj AS DWORD) AS LONG
IF riid = $IID_IUnknown OR _ ' // IUnknown interface
riid = $IID_IDispatch OR _ ' // IDispatch interface
riid = @@pUnkSink.riid THEN ' // Events dispatch interface
ppvObj = pUnkSink
EV_IDIspatchEvents_AddRef pUnkSink
FUNCTION = %S_OK
ELSE
ppvObj = %NULL
FUNCTION = %E_NOINTERFACE
END IF
END FUNCTION
' ########################################################################################
' ########################################################################################
' UI4 AddRef()
' Increments the reference count.
' ########################################################################################
FUNCTION EV_IDIspatchEvents_AddRef (BYVAL pUnkSink AS EV_IDispatchEventsVtbl PTR) AS DWORD
INCR @@pUnkSink.cRef
FUNCTION = @@pUnkSink.cRef
END FUNCTION
' ########################################################################################
' ########################################################################################
' UI4 Release()
' Releases our class if there is only a reference to him and decrements the reference counter.
' ########################################################################################
FUNCTION EV_IDispatchEvents_Release (BYVAL pUnkSink AS EV_IDispatchEventsVtbl PTR) AS DWORD
LOCAL pVtblAddr AS DWORD
IF @@pUnkSink.cRef = 1 THEN
pVtblAddr = @@pUnkSink.pVtblAddr
IF ISTRUE HeapFree(GetProcessHeap(), 0, BYVAL pVtblAddr) THEN
FUNCTION = 0
EXIT FUNCTION
ELSE
FUNCTION = @@pUnkSink.cRef
EXIT FUNCTION
END IF
END IF
DECR @@pUnkSink.cRef
FUNCTION = @@pUnkSink.cRef
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT GetTypeInfoCount([out] *UINT pctinfo)
' ########################################################################################
FUNCTION EV_EV_IDispatchEvents_GetTypeInfoCount (BYVAL pUnkSink AS EV_IDispatchEventsVtbl PTR, BYREF pctInfo AS DWORD) AS LONG
pctInfo = 0
FUNCTION = %S_OK
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT GetTypeInfo([in] UINT itinfo, [in] UI4 lcid, [out] **VOID pptinfo)
' ########################################################################################
FUNCTION EV_IDispatchEvents_GetTypeInfo (BYVAL pUnkSink AS EV_IDispatchEventsVtbl PTR, _
BYVAL itinfo AS DWORD, BYVAL lcid AS DWORD, BYREF pptinfo AS DWORD) AS LONG
FUNCTION = %E_NOTIMPL
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT GetIDsOfNames([in] *GUID riid, [in] **I1 rgszNames, [in] UINT cNames, [in] UI4 lcid, [out] *I4 rgdispid)
' ########################################################################################
FUNCTION EV_IDispatchEvents_GetIDsOfNames (BYVAL pUnkSink AS EV_IDispatchEventsVtbl PTR, _
BYREF riid AS GUID, BYREF rgszNames AS WSTRING, BYVAL cNames AS DWORD, BYVAL lcid AS DWORD, BYREF rgdispid AS LONG) AS LONG
FUNCTION = %E_NOTIMPL
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT Invoke([in] I4 dispidMember, [in] *GUID riid, [in] UI4 lcid, [in] UI2 wFlags, [in] *DISPPARAMS pdispparams, [out] *VARIANT pvarResult, [out] *EXCEPINFO pexcepinfo, [out] *UINT puArgErr)
' ########################################################################################
FUNCTION EV_IDispatchEvents_Invoke (BYVAL pUnkSink AS EV_IDispatchEventsVtbl PTR, BYVAL dispidMember AS LONG, BYREF riid AS GUID, _
BYVAL lcid AS DWORD, BYVAL wFlags AS WORD, BYREF pdispparams AS DISPPARAMS, BYREF pvarResult AS VARIANT, _
BYREF pexcepinfo AS EXCEPINFO, BYREF puArgErr AS DWORD) AS LONG
LOCAL hr AS LONG
IF @pUnkSink.pCallback THEN
CALL DWORD @@pUnkSink.pCallback USING EV_EventsCallback ( _
@@pUnkSink.pthis, dispidMember, pdispparams, pvarResult, @@pUnkSink.pCustData) TO hr
FUNCTION = hr
END IF
END FUNCTION
' ########################################################################################
' ########################################################################################
' Establishes a connection between the connection point object and the client's sink.
' Parameters:
' [in] pdisp = Pointer to the client's IDispatch.
' [in] riid = The GUID of the connection point (the iid of the events interface).
' [in] pCallback = Address of the callback function that will receive the events.
' [in] pCustData = Pointer to user defined data.
' [out] pdwCookie = A token that uniquely identifies this connection.
' Return value:
' Returns %S_OK or an error code.
' ########################################################################################
FUNCTION EV_Advise (BYVAL pdisp AS IDispatch, BYREF riid AS GUID, BYVAL pCallback AS DWORD, BYVAL pCustData AS DWORD, BYREF pdwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG ' // HRESULT code
LOCAL pthis AS DWORD ' // Pointer to the client's IDispatch
LOCAL pCPC AS DWORD ' // IConnectionPointContainer
LOCAL pCP AS DWORD ' // IConnectionPoint
LOCAL dwCookie AS DWORD ' // Returned token
LOCAL pUnkSink AS EV_IDispatchEventsVtbl PTR ' // IUnknown of the event sink class
pthis = OBJPTR(pdisp)
IF pthis = 0 THEN FUNCTION = %E_POINTER : EXIT FUNCTION
IF VARPTR(riid) = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
IF VARPTR(pdwCookie) = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
HRESULT = IUnknown_QueryInterface(pthis, $IID_IConnectionPointContainer, pCPC)
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
HRESULT = EV_IConnectionPointContainer_FindConnectionPoint(pCPC, riid, pCP)
IUnknown_Release pCPC
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
pUnkSink = EV_IDispatchEvents_BuildVtbl(pthis, riid, pCallback, pCustData)
IF ISTRUE pUnkSink THEN HRESULT = EV_IConnectionPoint_Advise(pCP, pUnkSink, dwCookie)
IUnknown_Release pCP
pdwCookie = dwCookie
@@pUnkSink.dwCookie = dwCookie
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' Releases the events connection identified with the cookie returned by the ConnectEvents function
' Parameters:
' [in] pdisp = Pointer to the Client's IDispatch.
' [in] riid = The GUID of the connection point (the iid of the events interface).
' [in] dwCookie = the token returned in the call to EV_Advise.
' Return value:
' Returns %S_OK or an error code.
' ########################################################################################
FUNCTION EV_Unadvise (BYVAL pdisp AS IDispatch, BYREF riid AS GUID, BYVAL dwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG ' HRESULT code
LOCAL pthis AS DWORD ' Pointer to the client's IDispatch
LOCAL pCPC AS DWORD ' IConnectionPointContainer
LOCAL pCP AS DWORD ' IConnectionPoint
pthis = OBJPTR(pdisp)
IF pthis = 0 THEN FUNCTION = %E_POINTER : EXIT FUNCTION
IF VARPTR(riid) = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
HRESULT = IUnknown_QueryInterface(pthis, $IID_IConnectionPointContainer, pCPC)
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
HRESULT = EV_IConnectionPointContainer_FindConnectionPoint(pCPC, riid, pCP)
IUnknown_Release pCPC
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
HRESULT = EV_IConnectionPoint_Unadvise(pCP, dwCookie)
IUnknown_Release pCP
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
EventSinkEx.inc
' ########################################################################################
' Event Sink Class
' Connects/disconnects from the events fired by a server.
' Call EVX_Advise to connect events and EVX_Unadvise to disconnect.
' Copyright (c) 2011 José Roca
' All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#INCLUDE THIS ONCE
%EVENTSINKEX_INC = 1
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "unknwn.inc"
#INCLUDE ONCE "ocidl.inc"
#INCLUDE ONCE "ole2utils.inc"
' ########################################################################################
' IConnectionPointContainer::FindConnectionPoint
' Returns a pointer to the IConnectionPoint interface of a connection point for a specified IID,
' if that IID describes a supported outgoing interface.
' ########################################################################################
FUNCTION EVX_IConnectionPointContainer_FindConnectionPoint (BYVAL pthis AS DWORD PTR, BYREF riid AS GUID, BYREF ppCP AS DWORD) AS LONG
LOCAL HRESULT AS LONG
CALL DWORD @@pthis[4] USING EVX_IConnectionPointContainer_FindConnectionPoint(pthis, riid, ppCP) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' IConnectionPoint::Advise
' Establishes a connection between the connection point object and the client's sink.
' ########################################################################################
FUNCTION EVX_IConnectionPoint_Advise (BYVAL pthis AS DWORD PTR, BYVAL pUnkSink AS DWORD, BYREF pdwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG
CALL DWORD @@pthis[5] USING EVX_IConnectionPoint_Advise(pthis, pUnkSink, pdwCookie) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' IConnectionPoint::Unadvise
' Terminates an advisory connection previously established through EVX_IConnectionPoint_Advise.
' The dwCookie parameter identifies the connection to terminate.
' ########################################################################################
FUNCTION EVX_IConnectionPoint_Unadvise (BYVAL pthis AS DWORD PTR, BYVAL dwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG
CALL DWORD @@pthis[6] USING EVX_IConnectionPoint_Unadvise(pthis, dwCookie) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' IDispatch virtual table
' ########################################################################################
TYPE EVX_IDispatchEventsVtbl
QueryInterface AS DWORD ' // Returns pointers to supported interfaces
AddRef AS DWORD ' // Increments reference count
Release AS DWORD ' // Decrements reference count
GetTypeInfoCount AS DWORD ' // Retrieves the number of type descriptions
GetTypeInfo AS DWORD ' // Retrieves a description of object's programmable interface
GetIDsOfNames AS DWORD ' // Maps name of method or property to DispId
Invoke AS DWORD ' // Calls one of the object's methods, or gets/sets one of its properties
pVtblAddr AS DWORD ' // Address of the virtual table
cRef AS DWORD ' // Reference count
pthis AS DWORD ' // IUnknown or IDispatch of the control that fires the events
pEvtObj AS DWORD ' // Pointer of the custom event sink class
dwCookie AS DWORD ' // Cookie
riid AS GUID ' // GUID of the events interface
END TYPE
' ########################################################################################
' ########################################################################################
' Builds the IDispatch Virtual Table
' ########################################################################################
FUNCTION EVX_IDispatchEvents_BuildVtbl (BYVAL pthis AS DWORD, BYREF riid AS GUID, BYVAL pEvtObj AS DWORD) AS DWORD
LOCAL pVtbl AS EVX_IDispatchEventsVtbl PTR
LOCAL pUnk AS EVX_IDispatchEventsVtbl PTR
pVtbl = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, SIZEOF(@pVtbl))
IF pVtbl = 0 THEN EXIT FUNCTION
@pVtbl.QueryInterface = CODEPTR(EVX_IDispatchEvents_QueryInterface)
@pVtbl.AddRef = CODEPTR(EVX_IDIspatchEvents_AddRef)
@pVtbl.Release = CODEPTR(EVX_IDispatchEvents_Release)
@pVtbl.GetTypeInfoCount = CODEPTR(EVX_EVX_IDispatchEvents_GetTypeInfoCount)
@pVtbl.GetTypeInfo = CODEPTR(EVX_IDispatchEvents_GetTypeInfo)
@pVtbl.GetIDsOfNames = CODEPTR(EVX_IDispatchEvents_GetIDsOfNames)
@pVtbl.Invoke = CODEPTR(EVX_IDispatchEvents_Invoke)
@pVtbl.pVtblAddr = pVtbl
@pVtbl.pthis = pthis
@pVtbl.riid = riid
@pVtbl.pEvtObj = pEvtObj
pUnk = VARPTR(@pVtbl.pVtblAddr)
FUNCTION = pUnk
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT QueryInterface([in] *GUID riid, [out] **VOID ppvObj)
' Returns the IUnknown of our class and increments the reference counter.
' ########################################################################################
FUNCTION EVX_IDispatchEvents_QueryInterface (BYVAL pUnkSink AS EVX_IDispatchEventsVtbl PTR, _
BYREF riid AS GUID, BYREF ppvObj AS DWORD) AS LONG
IF riid = $IID_IUnknown OR _ ' // IUnknown interface
riid = $IID_IDispatch OR _ ' // IDispatch interface
riid = @@pUnkSink.riid THEN ' // Events dispatch interface
ppvObj = pUnkSink
EVX_IDIspatchEvents_AddRef pUnkSink
FUNCTION = %S_OK
ELSE
ppvObj = %NULL
FUNCTION = %E_NOINTERFACE
END IF
END FUNCTION
' ########################################################################################
' ########################################################################################
' UI4 AddRef()
' Increments the reference count.
' ########################################################################################
FUNCTION EVX_IDIspatchEvents_AddRef (BYVAL pUnkSink AS EVX_IDispatchEventsVtbl PTR) AS DWORD
INCR @@pUnkSink.cRef
FUNCTION = @@pUnkSink.cRef
END FUNCTION
' ########################################################################################
' ########################################################################################
' UI4 Release()
' Releases our class if there is only a reference to him and decrements the reference counter.
' ########################################################################################
FUNCTION EVX_IDispatchEvents_Release (BYVAL pUnkSink AS EVX_IDispatchEventsVtbl PTR) AS DWORD
LOCAL pVtblAddr AS DWORD
IF @@pUnkSink.cRef = 1 THEN
pVtblAddr = @@pUnkSink.pVtblAddr
IF ISTRUE HeapFree(GetProcessHeap(), 0, BYVAL pVtblAddr) THEN
FUNCTION = 0
EXIT FUNCTION
ELSE
FUNCTION = @@pUnkSink.cRef
EXIT FUNCTION
END IF
END IF
DECR @@pUnkSink.cRef
FUNCTION = @@pUnkSink.cRef
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT GetTypeInfoCount([out] *UINT pctinfo)
' ########################################################################################
FUNCTION EVX_EVX_IDispatchEvents_GetTypeInfoCount (BYVAL pUnkSink AS EVX_IDispatchEventsVtbl PTR, BYREF pctInfo AS DWORD) AS LONG
pctInfo = 0
FUNCTION = %S_OK
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT GetTypeInfo([in] UINT itinfo, [in] UI4 lcid, [out] **VOID pptinfo)
' ########################################################################################
FUNCTION EVX_IDispatchEvents_GetTypeInfo (BYVAL pUnkSink AS EVX_IDispatchEventsVtbl PTR, _
BYVAL itinfo AS DWORD, BYVAL lcid AS DWORD, BYREF pptinfo AS DWORD) AS LONG
FUNCTION = %E_NOTIMPL
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT GetIDsOfNames([in] *GUID riid, [in] **I1 rgszNames, [in] UINT cNames, [in] UI4 lcid, [out] *I4 rgdispid)
' ########################################################################################
FUNCTION EVX_IDispatchEvents_GetIDsOfNames ( BYVAL pUnkSink AS EVX_IDispatchEventsVtbl PTR, _
BYREF riid AS GUID, BYREF rgszNames AS WSTRING, BYVAL cNames AS DWORD, BYVAL lcid AS DWORD, BYREF rgdispid AS LONG) AS LONG
FUNCTION = %E_NOTIMPL
END FUNCTION
' ########################################################################################
' ########################################################################################
' HRESULT Invoke([in] I4 dispidMember, [in] *GUID riid, [in] UI4 lcid, [in] UI2 wFlags, [in] *DISPPARAMS pdispparams, [out] *VARIANT pvarResult, [out] *EXCEPINFO pexcepinfo, [out] *UINT puArgErr)
' ########################################################################################
FUNCTION EVX_IDispatchEvents_Invoke (BYVAL pUnkSink AS EVX_IDispatchEventsVtbl PTR, BYVAL dispidMember AS LONG, BYREF riid AS GUID, _
BYVAL lcid AS DWORD, BYVAL wFlags AS WORD, BYREF pdispparams AS DISPPARAMS, BYREF pvarResult AS VARIANT, _
BYREF pexcepinfo AS EXCEPINFO, BYREF puArgErr AS DWORD) AS LONG
LOCAL hr AS LONG
LOCAL pEvtObj AS IDispatch
IF @@pUnkSink.pEvtObj THEN
POKE DWORD, VARPTR(pEvtObj), @@pUnkSink.pEvtObj
IF ISOBJECT(pEvtObj) THEN
pEvtObj.AddRef
hr = pEvtObj.Invoke(dispidMember, riid, lcid, wFlags, pdispparams, _
pvarResult, BYVAL VARPTR(pexcepinfo), puArgErr)
ELSE
POKE DWORD, VARPTR(pEvtObj), 0
END IF
END IF
pEvtObj = NOTHING
FUNCTION = hr
END FUNCTION
' ########################################################################################
' ########################################################################################
' Establishes a connection between the connection point object and the client's sink.
' Parameters:
' [in] pdisp = Pointer to the client's IDispatch.
' [in] pEvtObj = Pointer to the event class
' [in] riid = The GUID of the connection point (the iid of the events interface).
' [out] pdwCookie = A token that uniquely identifies this connection.
' Return value:
' Returns %S_OK or an error code.
' ########################################################################################
FUNCTION EVX_Advise (BYVAL pdisp AS IDispatch, BYVAL pEvtObj AS IDispatch, BYREF riid AS GUID, BYREF pdwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG ' // HRESULT code
LOCAL pthis AS DWORD ' // Pointer to the client's IDispatch
LOCAL pCPC AS DWORD ' // IConnectionPointContainer
LOCAL pCP AS DWORD ' // IConnectionPoint
LOCAL dwCookie AS DWORD ' // Returned token
LOCAL pUnkSink AS EVX_IDispatchEventsVtbl PTR ' // IUnknown of the event sink class
pthis = OBJPTR(pdisp)
IF pthis = 0 THEN FUNCTION = %E_POINTER : EXIT FUNCTION
IF VARPTR(riid) = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
IF VARPTR(pdwCookie) = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
HRESULT = IUnknown_QueryInterface(pthis, $IID_IConnectionPointContainer, pCPC)
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
HRESULT = EVX_IConnectionPointContainer_FindConnectionPoint(pCPC, riid, pCP)
IUnknown_Release pCPC
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
pUnkSink = EVX_IDispatchEvents_BuildVtbl(pthis, riid, OBJPTR(pEvtObj))
IF ISTRUE pUnkSink THEN HRESULT = EVX_IConnectionPoint_Advise(pCP, pUnkSink, dwCookie)
IUnknown_Release pCP
pdwCookie = dwCookie
@@pUnkSink.dwCookie = dwCookie
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
' ########################################################################################
' Releases the events connection identified with the cookie returned by the ConnectEvents function
' Parameters:
' [in] pdisp = Pointer to the Client's IDispatch.
' [in] riid = The GUID of the connection point (the iid of the events interface).
' [in] dwCookie = the token returned in the call to EVX_Advise.
' Return value:
' Returns %S_OK or an error code.
' ########################################################################################
FUNCTION EVX_Unadvise (BYVAL pdisp AS IDispatch, BYREF riid AS GUID, BYVAL dwCookie AS DWORD) AS LONG
LOCAL HRESULT AS LONG ' HRESULT code
LOCAL pthis AS DWORD ' Pointer to the client's IDispatch
LOCAL pCPC AS DWORD ' IConnectionPointContainer
LOCAL pCP AS DWORD ' IConnectionPoint
pthis = OBJPTR(pdisp)
IF pthis = 0 THEN FUNCTION = %E_POINTER : EXIT FUNCTION
IF VARPTR(riid) = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
HRESULT = IUnknown_QueryInterface(pthis, $IID_IConnectionPointContainer, pCPC)
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
HRESULT = EVX_IConnectionPointContainer_FindConnectionPoint(pCPC, riid, pCP)
IUnknown_Release pCPC
IF HRESULT <> %S_OK THEN FUNCTION = HRESULT : EXIT FUNCTION
HRESULT = EVX_IConnectionPoint_Unadvise(pCP, dwCookie)
IUnknown_Release pCP
FUNCTION = HRESULT
END FUNCTION
' ########################################################################################
Thanks for your thoughts Jose and Dominic. I took that example I posted several weeks ago and modified it as I described just to prove to myself that my conceptualization was correct, and it turned out it was. Interestingly, while doing that I recalled that none of the other methods of IDispatch other than Invoke() were being called, so, 'going for broke', I removed my code/implementation from them, and it worked fine. I see in your code Jose you removed implementation also from GetIDsOfNames(), etc. That interested me.
Realizing all this, the question then arises as to whether the actual event handlers should be implemented as global functions not part of any class/interface. I'm leaning in the direction of thinking it makes more sense to include them in a class implementation if for no other reason than classes form a good organizational principal. I'm not sure which way would be easier in terms of auto-generating code.
While I have your attention.....
What in the world is a DataObject? It shows up in the last few OLEDrag...() event methods of the MSFlexGridLib typelib...
From OLEView
[id(0x0000060e), helpstring("OLEStartDrag event"), helpcontext(0x00057e8b)]
void OLEStartDrag(
[in, out] DataObject** Data,
[in, out] long* AllowedEffects);
Likely an IDataObject? But I can't find any typedefs stating that. In my typelib code its coming out as a DataObject** just as shown above, and I see in the various PowerBASIC incs I have its being typed as an IDispatch Ptr. Is there documentation for that somewhere? I'm looking at the various *.h files but not finding it? And Google isn't coming up with much either (all related to .NET).
Ohhh! I just found it! Its a CoClass in MSFlexGridLib. Hmmmmm.
IDataObject
http://msdn.microsoft.com/en-us/library/windows/desktop/ms688421%28v=vs.85%29.aspx