Tweet
FUNCTION TB_CallByName ( _
BYVAL pthis AS DWORD, _ ' *IDispatch
BYVAL vNameOrId AS VARIANT, _ ' Name or identifier
BYVAL callType AS LONG, _ ' Call type
BYREF vParams() AS VARIANT, _ ' Array of variants
BYREF vResult AS VARIANT, _ ' Variant result
BYREF pex AS EXCEPINFO _ ' EXCEPINFO structure
) EXPORT AS LONG ' Error code
DIM dw_puArgErr AS DWORD, DISPID_PROPERTYPUT AS LONG, IID_NULL AS GUID
DIM vArgs(0) AS VARIANT, udt_DispParams AS DISPPARAMS
DIM hr AS LONG, strName AS STRING, DispID AS LONG
DIM nParams AS LONG, i AS LONG, idx AS LONG
' Check for null pointer
IF pthis = 0 THEN FUNCTION = %E_POINTER : EXIT FUNCTION
' Get the DispID
IF VARIANTVT(vNameOrId) = %VT_BSTR THEN
strName = UCODE$(VARIANT$(vNameOrId))
hr = IDispatch_GetIDOfName(pthis, strName, DispID)
IF hr THEN
FUNCTION = hr
EXIT FUNCTION
END IF
ELSE
DispID = VARIANT#(vNameOrId)
END IF
' Copy the array in reversed order
IF VARPTR(vParams()) THEN
nParams = UBOUND(vParams) - LBOUND (vParams) + 1
IF nParams > 0 THEN
REDIM vArgs(nParams - 1)
idx = nParams - 1
FOR i = LBOUND(vParams) TO UBOUND(vParams)
IF VARIANTVT(vParams(i)) = %VT_EMPTY THEN
vArgs(idx) = ERROR %DISP_E_PARAMNOTFOUND
ELSE
vArgs(idx) = vParams(i)
END IF
DECR idx
IF idx < 0 THEN EXIT FOR
NEXT
END IF
END IF
IF CallType = 4 OR CallType = 8 THEN ' %DISPATCH_PROPERTYPUT and %DISPATCH_PROPERTYPUTREF
DISPID_PROPERTYPUT = -3
udt_DispParams.CountNamed = 1
udt_DispParams.NamedDispId = VARPTR(DISPID_PROPERTYPUT)
END IF
udt_DispParams.CountArgs = nParams
IF nParams > 0 THEN udt_DispParams.VariantArgs = VARPTR(vArgs(0))
FUNCTION = IDispatch_Invoke(pthis, DispID, IID_NULL, 0, CallType, udt_DispParams, vResult, pex, dw_puArgErr)
END FUNCTION
' ****************************************************************************************
' Maps a single member to a corresponding DispID, which can be used on subsequent calls to
' IDispatch_Invoke.
' ****************************************************************************************
DECLARE FUNCTION Proto_IDispatch_GetIDOfName (BYVAL pthis AS DWORD PTR, BYREF riid AS GUID, BYREF rgszNames AS STRING, BYVAL cNames AS DWORD, BYVAL lcid AS DWORD, BYREF rgdispid AS LONG) AS LONG
' ****************************************************************************************
FUNCTION IDispatch_GetIDOfName (BYVAL pthis AS DWORD PTR, BYREF strName AS STRING, BYREF rgdispid AS LONG) AS LONG
LOCAL HRESULT AS LONG, riid AS GUID
IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
CALL DWORD @@pthis[5] USING Proto_IDispatch_GetIDOfName (pthis, riid, strName, 1, 0, rgdispid) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ****************************************************************************************
' ****************************************************************************************
' Provides access to properties and methods exposed by an object.
' Note: if the call to Invoke returns %DISP_E_EXCEPTION (&H80020009), the EXCEPINFO
' structure is filled with error information. Three of his members are pointers to
' unicode strings that you can read with the TB_ExcepInfoErrorDescription,
' TB_ExcepInfoErrorSource and TB_ExcepInfoErrorHelpFile functions, and that you must free
' with SysFreeString: SysFreeString pexcepinfo.bstrDescription,
' SysFreeString pexcepinfo.bstrSource, SysFreeString pexcepinfo.bstrHelpFile.
' ****************************************************************************************
FUNCTION IDispatch_Invoke (BYVAL pthis AS DWORD 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 HRESULT AS LONG
IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
CALL DWORD @@pthis[6] USING IDispatch_Invoke (pthis, dispidMember, riid, lcid, wFlags, pdispparams, pvarResult, pexcepinfo, puArgErr) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' ****************************************************************************************
Comment