• Welcome to Jose's Read Only Forum 2023.
 

Dynamic late binding reference

Started by Eros Olmi, August 19, 2010, 02:30:56 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Eros Olmi

Hi all,

I would like to understand how to perform late binding dynamically, I mean the same steps that a PB compiler does when resolving late binding at compile time but I need at runtime. I need to add this functionality as native to future thinBasic programming language versions.

In http://www.powerbasic.com/support/help/pbwin/html/Late_Binding.htm PB writes:
QuotePowerBASIC packages up the Method Name (Method1) and the names of any named parameters (none in this example - more about that later), and passes them to a special DISPATCH function.  After a bit of time for lookup, the Dispatch ID (let's say the number 77) is returned. PowerBASIC then converts the two parameters to Variants and packages the whole thing up to call another special Dispatch function.  This tells the server to execute Method number 77 using the two enclosed parameters.  Finally, it returns with an hResult code to indicate success or failure.
I need to do that but at runtime, dynamically.

Can someone give reference to a good low level documentation on how to do it?

Thanks in advance.
Eros

thinBasic Script Interpreter - www.thinbasic.com | www.thinbasic.com/community
Win7Pro 64bit - 8GB Ram - Intel i7 M620 2.67GHz - NVIDIA Quadro FX1800M 1GB

José Roca

 
What it does is similar to my CallByName function, with added complexity to deal with named parameters: http://www.jose.it-berater.org/smfforum/index.php?topic=117.0

To retrieve the DispID, you need to call the method GetIDsOfNames passing the name of the method or property. With the parameters, you build an array of variants. Finally, you fill the DISPPARAMS structure and call IDispatch::Invoke.

The only difference between early binding and late binding is that, for the later, you have to call GetIDsOfNames to retrieve the DispID at runtime.

Edwin Knoppert

I ever did a test, the overhead of late bound is just a few percent vs GetIDsOfNames() and use the result of those directly.
For speed better is use direct (non-dispatch) interface calls.

Eros Olmi

Thanks a lot José.
I think you already replied to me many times on this matter.
I just need to start working on that.

Thanks
Eros

PS: just to let you know that your link to CallByName topic give me the following error "The topic or board you are looking for appears to be either missing or off limits to you." and I cannot see it. Maybe an authorization problem. In any case I have sources because they are available in PB source forum.
thinBasic Script Interpreter - www.thinbasic.com | www.thinbasic.com/community
Win7Pro 64bit - 8GB Ram - Intel i7 M620 2.67GHz - NVIDIA Quadro FX1800M 1GB

José Roca

Sometimes it can be handy to be able to call COM methods and properties dynamically at runtime. For this purpose you need a generic function allowing you to pass the name of the method or property, the type of call and the parameters, and that will return you the result and error information.

To implement such a function, we need to call the low-level COM methods GetIDsOfNames and Invoke of the IDIspatch interface. GetIDsOfNames maps a single member and an optional set of argument names to a corresponding set of integer DISPIDs (dispatch identifiers), which can be used on subsequent calls to Invoke. Invoke provides access to properties and methods exposed by an object.

In this example, TB_CallByName is a generic function that calls the Invoke method of IDispatch to invoke a method or property. As arguments, it accepts a pointer to the object's IDispatch implementation, the name or DISPID of the member to invoke, flags that control the invocation, and a variable list of the member's arguments. It returns the result in a variant variable passed by reference (use BYVAL %NULL if the called method or property doesn't return a result), an error code as the result of the function and rich error information in a variable declared as EXCEPINFO (use BYVAL %NULL if you don't want/need this information).

The variable pthis is a pointer to the object's IDispatch interface. Using this pointer and the name of the member, it calls GetIDsOfNames to get the DISPID of the requested member, that will be used later in the call to Invoke.

The invocation flags specify whether a method or property is being invoked. The helper function simply passes these flags directly to Invoke.

%DISPATCH_METHOD = 1  ' The member is called using a normal function invocation syntax.
%DISPATCH_PROPERTYGET = 2  ' The function is invoked using a normal property-access syntax.
%DISPATCH_PROPERTYPUT = 4  ' The function is invoked using a property value assignment syntax.
%DISPATCH_PROPERTYPUTREF = 8  ' The function is invoked using a property reference assignment syntax.

The helper function next fills in the DISPPARAMS structure with the parameters. In PowerBASIC, DISPPARAMS is an intrinsic structure that has the following internal representation:

TYPE DispParams
  VariantArgs AS VARIANT PTR ' Array of arguments
  NamedDispId AS LONG PTR ' DISPIDs of named arguments
  CountArgs AS DWORD ' Number of arguments
  CountNamed AS DWORD ' Number of named arguments
END TYPE

The VariantArgs field is a pointer to an array of VARIANTs. Each element of the array specifies an argument, whose position in the array corresponds to its position in the parameter list of the method definition. The CountArgs field specifies the total number of arguments, and the CountNamed field specifies the number of named arguments.

Property put functions have a named argument that is the new value for the property. The DISPID of this argument is DISPID_PROPERTYPUT, that has -3 as identifier.

To build the VariantArgs array, the helper function retrieves the parameter values and types from the passed array of variants and copies them in reversed order. %VT_EMPTY variants (you make them using [LET] vrntvar = EMPTY) must be used for optional parameters that you want to omit. For each empty variant, the helper function assigns the value ERROR %DISP_E_PARAMNOTFOUND in the arguments array for Invoke. To identify and omited optional parameter, COM wants a %VT_ERROR variant filled with the %DISP_E_PARAMNOTFOUND value.

In addition, for put and putref properties, the CountNamed field must contain a value of 1 and the NamedDispid field must contain the address of a variable containing the %DISPID_PROPERTYPUT constant value (-3).

DispID indicates the method or property being invoked. The value IID_NULL (a null GUID) must be specified for all Invoke calls, and 0 is the value of LOCALE_USER_DEFAULT, denoting the default locale identifier (LCID) for the current user. In the final two arguments, pex and dw_puArgErr, Invoke can return error information.

If the invoked member has defined an exception handler, it returns exception information in pex. If certain errors occur in the array of arguments, dw_puArgErr points to the errant argument. The function return value hr is a LONG value that indicates success (0) or various types of failure. If hr is filled with the value %DISP_E_EXCEPTION (&H80020009), the called method or property should fill pex with error information. Three fields of the EXCEPINFO structure, bstrSource, bstrDescription and bstrHelpFile are pointers to dynamic unicode strings allocated with SysAllocString that must be freed with SysFreeString to avoid memory leaks.

    LOCAL bstrlen AS LONG
    LOCAL strDescription AS STRING
    LOCAL strSource AS STRING
    LOCAL strHelpFile AS STRING
   
    IF pex.bstrDescription THEN
       bstrlen = SysStringByteLen(BYVAL pex.bstrDescription)
       IF bstrlen THEN strDescription = ACODE$(PEEK$(pex.bstrDescription, bstrlen))
       SysFreeString pex.bstrDescription
    END IF

    IF pex.bstrSource THEN
       bstrlen = SysStringByteLen(BYVAL pex.bstrSource)
       IF bstrlen THEN strSource = ACODE$(PEEK$(pex.bstrSource, bstrlen))
       SysFreeString pex.bstrSource
    END IF

    IF pex.bstrHelpFile THEN
       bstrlen = SysStringByteLen(BYVAL pex.bstrHelpFile)
       IF bstrlen THEN strHelpFile = ACODE$(PEEK$(pex.bstrHelpFile, bstrlen))
       SysFreeString pex.bstrHelpFile
    END IF

The following implementation can be used with PBWin 7.x+/8.x+ and PBCC 3.x+/4.x+.


' ========================================================================================
' EXCEPINFO structure
' ========================================================================================
TYPE EXCEPINFO
   wCode AS WORD               ' An error code describing the error.
   wReserved AS WORD           ' Reserved
   bstrSource AS DWORD         ' Source of the exception.
   bstrDescription AS DWORD    ' Textual description of the error.
   bstrHelpFile AS DWORD       ' Help file path.
   dwHelpContext AS DWORD      ' Help context ID.
   pvReserved AS DWORD         ' Reserved
   pfnDeferredFillIn AS DWORD  ' Pointer to function that fills in Help and description info.
   scode AS DWORD              ' An error code describing the error
END TYPE
' ========================================================================================

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

%DISPATCH_METHOD         = 1  ' The member is called using a normal function invocation syntax.
%DISPATCH_PROPERTYGET    = 2  ' The function is invoked using a normal property-access syntax.
%DISPATCH_PROPERTYPUT    = 4  ' The function is invoked using a property value assignment syntax.
%DISPATCH_PROPERTYPUTREF = 8  ' The function is invoked using a property reference assignment syntax.

' ========================================================================================
' CallByName - Generic function to call COM methods and properties.
' Parameters:
'   pthis : Address of a pointer to IDispatch.
'   vNameOrId : Name of the method or property, or identifier number (DispID).
'   callType : Flags describing the context of the Invoke call:
'     %DISPATCH_METHOD
'       The member is invoked as a method. If a property has the same name, both this and the
'       %DISPATCH_PROPERTYGET flag may be set.
'     %DISPATCH_PROPERTYGET
'       The member is retrieved as a property or data member.
'     %DISPATCH_PROPERTYPUT
'       The member is changed as a property or data member.
'     %DISPATCH_PROPERTYPUTREF
'       The member is changed by a reference assignment, rather than a value assignment. This
'       flag is valid only when the property accepts a reference to an object.
'   vParams() : Array of variant parameters. EMPTY variants are considered as optionals by
'       the function, that assigns to the them the value ERROR %DISP_E_PARAMNOTFOUND. This
'       is the standard way to deal with optional parameters in COM programming.
'       If the method or property has not values pass BYVAL %NULL.
'   vResult : Variant where the result is to be stored (pass BYVAL %NULL if you expect no result.
'       This argument is ignored if DISPATCH_PROPERTYPUT or DISPATCH_PROPERTYPUTREF is specified.
'   pex : Address of an EXCEPINFO structure where to return error information. Can be %NULL.
'       This structure is only filled when the error returned is %DISP_E_EXCEPTION.
' ========================================================================================
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
      IF nParams = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
      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
' ========================================================================================


The following code creates an instance of Excel and uses the helper function to set the Visible property to TRUE.


FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   DIM oExcel AS DISPATCH
   DIM vParams(0) AS VARIANT
   DIM pex AS EXCEPINFO

   SET oExcel = NEW DISPATCH IN "Excel.Application"
   IF ISFALSE ISOBJECT(oExcel) THEN GOTO Terminate

   REDIM vParams(0)
   vParams(0) = 1
   hr = TB_CallByName(OBJPTR(oExcel), "Visible", %DISPATCH_PROPERTYPUT, vParams(), BYVAL %NULL, BYVAL %NULL)
   IF hr THEN PRINT "hr = " & HEX$(hr)
   WAITKEY$

Terminate:

   SET oExcel = NOTHING

END FUNCTION


For the sake of completenes, here is a version that uses the ability of PBWin 8.x+ and PBCC 4.x+ to pass a dispatch or object variable as a parameter and its undocumented build in implementation of the IDispatch interface.


' SED_PBCC - Use the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"

' ========================================================================================
' EXCEPINFO structure
' ========================================================================================
TYPE EXCEPINFO
   wCode AS WORD               ' An error code describing the error.
   wReserved AS WORD           ' Reserved
   bstrSource AS DWORD         ' Source of the exception.
   bstrDescription AS DWORD    ' Textual description of the error.
   bstrHelpFile AS DWORD       ' Help file path.
   dwHelpContext AS DWORD      ' Help context ID.
   pvReserved AS DWORD         ' Reserved
   pfnDeferredFillIn AS DWORD  ' Pointer to function that fills in Help and description info.
   scode AS DWORD              ' An error code describing the error
END TYPE
' ========================================================================================

%DISPATCH_METHOD         = 1  ' The member is called using a normal function invocation syntax.
%DISPATCH_PROPERTYGET    = 2  ' The function is invoked using a normal property-access syntax.
%DISPATCH_PROPERTYPUT    = 4  ' The function is invoked using a property value assignment syntax.
%DISPATCH_PROPERTYPUTREF = 8  ' The function is invoked using a property reference assignment syntax.

' ========================================================================================
' CallByName - Generic function to call COM methods and properties.
' Parameters:
'   oObj : Object variable
'   vNameOrId : Name of the method or property, or identifier number (DispID).
'   callType : Flags describing the context of the Invoke call:
'     %DISPATCH_METHOD
'       The member is invoked as a method. If a property has the same name, both this and the
'       %DISPATCH_PROPERTYGET flag may be set.
'     %DISPATCH_PROPERTYGET
'       The member is retrieved as a property or data member.
'     %DISPATCH_PROPERTYPUT
'       The member is changed as a property or data member.
'     %DISPATCH_PROPERTYPUTREF
'       The member is changed by a reference assignment, rather than a value assignment. This
'       flag is valid only when the property accepts a reference to an object.
'   vParams() : Array of variant parameters. EMPTY variants are considered as optionals by
'       the function, that assigns to the them the value ERROR %DISP_E_PARAMNOTFOUND. This
'       is the standard way to deal with optional parameters in COM programming.
'       If the method or property has not values pass BYVAL %NULL.
'   vResult : Variant where the result is to be stored (pass BYVAL %NULL if you expect no result.
'       This argument is ignored if DISPATCH_PROPERTYPUT or DISPATCH_PROPERTYPUTREF is specified.
'   pex : Address of an EXCEPINFO structure where to return error information. Can be %NULL.
'       This structure is only filled when the error returned is %DISP_E_EXCEPTION.
' ========================================================================================
FUNCTION TB_CallByName ( _
    BYVAL oObj AS DISPATCH, _                                  ' *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 the validity of the object variable
    IF ISFALSE ISOBJECT(oObj) THEN FUNCTION = %E_POINTER : EXIT FUNCTION

    ' Get the DispID
    IF VARIANTVT(vNameOrId) = %VT_BSTR THEN
       strName = UCODE$(VARIANT$(vNameOrId))
       hr = oObj.GetIDsOfNames(IID_NULL, strName, 1, 0, VARPTR(DispID))
       IF hr THEN
          FUNCTION = OBJRESULT
          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
      IF nParams = 0 THEN FUNCTION = %E_INVALIDARG : EXIT FUNCTION
      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))

   ERRCLEAR  ' Clear the ERR variable
   hr = oObj.Invoke(DispID, IID_NULL, 0, CallType, udt_DispParams, vResult, VARPTR(pex), VARPTR(dw_puArgErr))
   FUNCTION = OBJRESULT

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   DIM oExcel AS DISPATCH
   DIM vParams(0) AS VARIANT
   DIM pex AS EXCEPINFO

   SET oExcel = NEW DISPATCH IN "Excel.Application"
   IF ISFALSE ISOBJECT(oExcel) THEN GOTO Terminate

   REDIM vParams(0)
   vParams(0) = 1
   hr = TB_CallByName(oExcel, "Visible", %DISPATCH_PROPERTYPUT, vParams(), BYVAL %NULL, BYVAL %NULL)
   IF hr THEN PRINT "hr = " & HEX$(hr)
   WAITKEY$

Terminate:

   SET oExcel = NOTHING

END FUNCTION
' ========================================================================================


José Roca

#5
Quote
PS: just to let you know that your link to CallByName topic give me the following error "The topic or board you are looking for appears to be either missing or off limits to you." and I cannot see it. Maybe an authorization problem. In any case I have sources because they are available in PB source forum.

I have reposted it above. The posts for PB 8 are hidden because many people became confused seeing different code for the same examples (using wrappers and using the new direct interface calls).

Eros Olmi

Great José.
Is this the method you use in TypeLib Browser?
thinBasic Script Interpreter - www.thinbasic.com | www.thinbasic.com/community
Win7Pro 64bit - 8GB Ram - Intel i7 M620 2.67GHz - NVIDIA Quadro FX1800M 1GB

José Roca

 
There was a version of the browser that had an option to generate wrappers using this technique, in the times of PBWIN 7.x, but the browser itself uses the low-level ITypeLib and ITypeInfo interfaces.