DispCallFunc - 64bit VBA

[Dan_W]

WIth the help of Jaafar, I'm trying to learn how to use the DispCallFunc API with 64 bit API. I have been trying to work my way through the examples at the following tutorial: Windows API DispCallFunc as function pointer in VBA

And managed to get the following working:

Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long

Public Sub someFunction()
    MsgBox "DispCallFunc just called me!"
End Sub
'
Public Sub tester()
    '
    Dim DispCallFuncResult As Long
    Dim result As Variant: result = vbEmpty
    DispCallFuncResult = DispCallFunc( _
        0, _
        AddressOf someFunction, _
        CLng(4), _
        VbVarType.vbEmpty, _
        0, _
        0, _
        0, _
        VarPtr(result))
End Sub

I cannot, however, get the second example to work. The returning result is 0, though it clearly shouldn't be:

Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As LongPtr, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long

Public Function someFunction(ByVal x As Double, ByVal y As Double) As Double
    someFunction = x * y
End Function
'
Public Sub tester()
    '
    Dim DispCallFuncResult As Long
    Dim result As Variant: result = vbEmpty
    '
    Dim x As Double: x = 1.234
    Dim y As Double: y = 9.876
    '
    Dim vx As Variant: vx = CVar(x)
    Dim vy As Variant: vy = CVar(y)
    '
    Dim varTypes(0 To 1) As Long
    varTypes(0) = VarType(vx)
    varTypes(1) = VarType(vy)
    '
    Dim varPointers(0 To 1) As LongPtr
    varPointers(0) = VarPtr(vx)
    varPointers(1) = VarPtr(vy)
    '
    DispCallFuncResult = DispCallFunc( _
        0, _
        AddressOf someFunction, _
        CLng(4), _
        VbVarType.vbDouble, _
        2, _
        VarPtr(varTypes(0)), _
        VarPtr(varPointers(0)), _
        VarPtr(result))
    '
    MsgBox result
End Sub

Any guidance would be appreciated.

 

[jkpieterse]

Sorry, couldn't resist: Why would you want to do this?

 

[RoryA]

The declaration should be:

Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByVal paTypes As LongPtr, ByVal paValues As LongPtr, ByVal retVAR As LongPtr) As Long

and the varTypes array should be of Integer type, not Long.

 

[Jaafar Tribak]

Hi Dan,

We tend to overlook the official documentation for the apis. The MS docs are quite useful for knowing the actual and correct signature of the functions particularly the variable types of the IN and OUT arguments as well as the function return type if any.

In the case of DispCallFunc we have this:

'HRESULT DispCallFunc(
'  void       *pvInstance,
'  ULONG_PTR  oVft,
'  CALLCONV   cc,
'  VARTYPE    vtReturn,
'  UINT       cActuals,
'  VARTYPE    *prgvt,
'  VARIANTARG **prgpvarg,
'  VARIANT    *pvargResult
');

Although these are var types are in C , with practice, it is not too difficult to figure out their equivalent in VB.

So, strictly speaking, our api declaration should be like this in x64:

Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" ( _
    ByVal pvInstance As LongPtr, _
    ByVal oVft As LongPtr, _
    ByVal cc As Long, _
    ByVal vtReturn As Integer, _
    ByVal cActuals As Long, _
    ByRef prgvt As Integer, _
    ByRef prgpvarg As LongPtr, _
    ByRef pvargResult As Variant _
) As Long

Notice that some of the arguments in the C signature start with a * (star) and a small p ... these normally refer to variables expecting pointers.
In the case of **prgpvarg, you see two ** stars preceeding the p letter . This means that the prgpvarg var expects to be passed a pointer to a pointer.

In our VB declare, paiing pointers correspond to using ByRef.

The way we declare an api dictates how we use it later on in our code.

So, if we use the above official api declare, our code should look like this:

Public Function someFunction(ByVal x As Double, ByVal y As Double) As Double
    someFunction = x * y
End Function

Public Sub tester()
    '
    Dim DispCallFuncResult As Long
    Dim result As Variant: result = vbEmpty
    '
    Dim x As Double: x = 1.234
    Dim y As Double: y = 9.876
    '
    Dim vx As Variant: vx = x ' CVar(x)
    Dim vy As Variant: vy = y  'CVar(y)
    '
    Dim varTypes(0 To 1) As Integer
    varTypes(0) = VarType(vx)
    varTypes(1) = VarType(vy)
    '
    Dim varPointers(0 To 1) As LongPtr
    varPointers(0) = VarPtr(vx)
    varPointers(1) = VarPtr(vy)
    '
    DispCallFuncResult = DispCallFunc( _
        0^, _
        AddressOf someFunction, _
        4&, _
        VbVarType.vbDouble, _
        2&, _
        varTypes(0), _
        varPointers(0), _
        result)
    '
    MsgBox result
End Sub

Notice that we now don't need to use VarPtr in the last 3 parameters when calling the api function as we are already passing var address pointers (ByRef).

Having said that, we could use aliases of the same api but that would impact how we write the calling code.

So for example, if we wre to use the api daclare that Rory posted , the code would change and look like the following:

Option Explicit

Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" ( _
    ByVal pvInstance As LongPtr, _
    ByVal offsetinVft As LongPtr, _
    ByVal CallConv As Long, _
    ByVal retTYP As Integer, _
    ByVal paCNT As Long, _
    ByVal paTypes As LongPtr, _
    ByVal paValues As LongPtr, _
    ByVal retVAR As LongPtr _
) As Long

Public Function someFunction(ByVal x As Double, ByVal y As Double) As Double
    someFunction = x * y
End Function

Public Sub tester()
    '
    Dim DispCallFuncResult As Long
    Dim result As Variant: result = vbEmpty
    '
    Dim x As Double: x = 1.234
    Dim y As Double: y = 9.876
    '
    Dim vx As Variant: vx = CVar(x)
    Dim vy As Variant: vy = CVar(y)
    '
    Dim varTypes(0 To 1) As Integer
    varTypes(0) = VarType(vx)
    varTypes(1) = VarType(vy)
    '
    Dim varPointers(0 To 1) As LongPtr
    varPointers(0) = VarPtr(vx)
    varPointers(1) = VarPtr(vy)
    '
    DispCallFuncResult = DispCallFunc( _
        0, _
        AddressOf someFunction, _
        CLng(4), _
        VbVarType.vbDouble, _
        2, _
        VarPtr(varTypes(0)), _
        VarPtr(varPointers(0)), _
        VarPtr(result))
    '
    MsgBox result
End Sub

Notice that the last 3 parameters are now using VarPtr to pass the actual pointers as per the alias declaration.

 

[Dan_W]

Sorry, couldn't resist: Why would you want to do this?

It's a fair question - I ask myself this all the time!
I'm trying to wrap my head around DispCallFunc to get access to the WinRT API set and to interfaces (without having to rely on Type Libraries). Example: [NOTE] Using WinRT API from VBA

 

[Dan_W]

The declaration should be:

Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByVal paTypes As LongPtr, ByVal paValues As LongPtr, ByVal retVAR As LongPtr) As Long

and the varTypes array should be of Integer type, not Long.

Thank you @RoryA - youre absolutely right. That was a stupid oversight on my part. I kept running into Type Mismatch errors with the VarPtr function, and I think I was being a bit overly enthusiatic with changing the data types here there and everywhere, and I forgot to change them back to what they were.

 

[Dan_W]

Thank you @Jaafar Tribak , this is extremely helpful.

In the case of **prgpvarg, you see two ** stars preceeding the p letter . This means that the prgpvarg var expects to be passed a pointer to a pointer.

Notice that the last 3 parameters are now using VarPtr to pass the actual pointers as per the alias declaration.

Ahh, this makes a lot of sense. I think I understand now.
I'll keep experimenting, and will read through your other DispCallFunc demos.