pure dispinterfaces are strange

[Frederick J. Harris]

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.

[Dominic Mitchell]

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.

Code Select Expand


'-------------------------------------------------------------------------------
'
' 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


[José Roca]

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

Code Select Expand


' ########################################################################################
' 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

Code Select Expand


' ########################################################################################
' 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
' ########################################################################################


[Frederick J. Harris]

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

Code Select Expand


[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).

[Frederick J. Harris]

Ohhh!  I just found it!  Its a CoClass in MSFlexGridLib.   Hmmmmm.

[José Roca]

IDataObject

http://msdn.microsoft.com/en-us/library/windows/desktop/ms688421%28v=vs.85%29.aspx