How to call IEnumVARIANT::Next() with DispCallFunc() - Without external TLBs

[sancarn]

Hi All,

I've been trying for the past few hours to call IEnumVARIANT::Next() on a collection Enum. I would like this as I am building a wrapper for EnumVARIANTs giving them more possibilities.

'Example - Ideally i'd like to use more than just a Collection object
Dim col as Collection
set col = new Collection

Dim e as IEnumVARIANT
set e = col.[_NewEnum]

Do While true
  Dim x as variant
  CopyVariant x , vbEnumNext(e)
  if isNull(x) then Exit Do
   
  '...
Loop

Every time I try to do this however I get a crash... I'm clearly doing something wrong...

Private Declare PtrSafe Function EnumCall Lib "oleaut32.dll" Alias "DispCallFunc" (ByRef pObject As IEnumVARIANT, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef pTypes() As Long, ByRef pValues() As Long, ByRef retVar As Variant) As Long

Private Enum CALLRETURNTUYPE_ENUM
    CR_None = vbEmpty
    CR_LONG = vbLong
    CR_BYTE = vbByte
    CR_INTEGER = vbInteger
    CR_SINGLE = vbSingle
    CR_DOUBLE = vbDouble
    CR_CURRENCY = vbCurrency
    ' if the value you need isn't in above list, you can pass the value manually to the
    ' CallFunction_DLL method below. For additional values, see:
    ' http://msdn.microsoft.com/en-us/library/cc237865.aspx
End Enum
Const CC_STDCALL As Long = 4&

Public Function vbEnumNext(ByRef e As IEnumVARIANT) as Variant
    Dim paTypes() As Long
    ReDim paTypes(1 To 3)
    paTypes(1) = CR_INTEGER
    paTypes(2) = CR_LONG
    paTypes(3) = CR_LONG
    
    Dim p1 As Long: p1 = 1
    Dim p2 As Variant
    Dim p3 As Long
    
    Dim paValues(1 To 3) As Long
    paValues(1) = VarPtr(p1)
    paValues(2) = VarPtr(p2)
    paValues(3) = VarPtr(p3)
    
    Dim hResult As Long, retVar As Variant
    hResult = EnumCall(e, 4, CC_STDCALL, CALLRETURNTUYPE_ENUM.CR_LONG, 3, paValues, paTypes, retVar)
    Call CopyVariant(vbEnumNext, retVar)
End Function

Public Sub CopyVariant(ByRef dest As Variant, ByVal src As Variant)
  If IsObject(src) Or VarType(src) = 13 Then
    Set dest = src
  Else
    dest = src
  End If
End Sub

I've had numerous issues from compile errors to straight up crashes... I've also searched this forum and was surprised that I didn't actually find this being done before... I've seen 1 post by fafalone where oleexp3.IEnumVARIANT was used, but I want to avoid the need for external type libraries. I've also tried using passing in ObjPtr(e) as the first argument, however it appears ObjPtr doesn't support a parameter of type IEnumVARIANT (which I find a little odd given that IEnumVARIANT does implement IUnknown...)

Has anyone got any ideas of where I'm going wrong / have an example?

[sancarn]

May I ask why you need this instead of just doing a For/Next?

You may It's for a class I am working on which wraps enumerable "things". Currently I only offer a wrapper around IEnumVARIANT i.e.

For each x in pObject
   '...
Next

However I want to be able to initialise the object from different sources other than a Object, e.g. An array, or a callback function. I want to be able to use:

Do While true
  Dim x as variant
  select case iMode 
    case eEnumVARIANT
      CopyVariant x , vbEnumNext(e)
    case eArray
      index = index + 1
      CopyVariant x, loopArray(index)
    case eCallback
      CopyVariant x, oCallback(lastValue)
  end select
  
  if isNull(x) then Exit Do
   
  '...
Loop

With this ability I'll be able to treat callbacks like Fibonacci(val) as enumerators Currently the only alternative I have is to replicate the entire sub loop with all the code:

Public Function ForEach(Optional ByVal cb As stdICallable, Optional ByVal WithIndex as boolean = false) As stdEnumerator
    select case iMode
        case EnumeratorType.FromCallable
           Dim x as variant
           Do While True
             Call CopyVariant(x,root.Run(x))
             if isNull(x) then Exit Do
             i=i+1
             if withIndex then
               Call cb.run(i,v)
             else
               Call cb.run(v)
             end if
          Loop
        case EnumeratorType.FromIEnumVariant
            Dim v as variant, i as long: i=0
            For Each v In pEnumObject
                i=i+1
                if withIndex then
                    Call cb.Run(i,v)
                else
                    Call cb.Run(v)
                end if
            Next
    End Select

    set ForEach = me
End Function

Given that my class has 30 methods I don't really want to copy and paste code all over the place (maintainability would be rubbish).

Generally speaking the long term goal of what I am doing will look something like this:

Call stdEnumerator.CreateFromCallable(fibonacci,0).map(stdLambda.Create("$1*10")).filter(stdLambda.Create("$1<=20")).forEach(debugPrint)
Call stdEnumerator.CreateFromEnumVARIANT(oCol).map(stdLambda.Create("$1*10")).filter(stdLambda.Create("$1<=20")).forEach(debugPrint)

[Eduardo-]

OK, thank you for the explanation.
I had deleted my message because after I posted it I re-read your OP more caresfully and saw:

I would like this as I am building a wrapper for EnumVARIANTs giving them more possibilities.

[LaVolpe]

This is likely one reason why you are crashing...

hResult = EnumCall(e, 4, ...)

4 cannot be correct. Since IEnumVARIANT inherits from IUnknown, then the 1st 3 entries of IEnumVARIANT vTable are QueryInterface, AddRef & Release. The value 4 would be AddRef. The IEnumVARIANT:Next would be 16 not 4 (if you were trying to call the that method). I didn't verify the method order in IEnumVARIANT, it looks like ?...
-- IUnknown:QueryInterface
-- IUnknown:AddRef
-- IUnknown:Release
-- IEnumVARIANT:Clone
-- IEnumVARIANT:Next
-- IEnumVARIANT:Reset
-- IEnumVARIANT:Skip
double check these against oleexp3.IEnumVARIANT maybe.

Honestly, I stopped examining your code after I saw that initial error.

[sancarn]

This is likely one reason why you are crashing...

hResult = EnumCall(e, 4, ...)

4 cannot be correct. Since IEnumVARIANT inherits from IUnknown, then the 1st 3 entries of IEnumVARIANT vTable are QueryInterface, AddRef & Release. The value 4 would be AddRef. The IEnumVARIANT:Next would be 16 not 4 (if you were trying to call the that method). I didn't verify the method order in IEnumVARIANT, it looks like ?...
-- IUnknown:QueryInterface
-- IUnknown:AddRef
-- IUnknown:Release
-- IEnumVARIANT:Clone
-- IEnumVARIANT:Next
-- IEnumVARIANT:Reset
-- IEnumVARIANT:Skip
double check these against oleexp3.IEnumVARIANT maybe.

Honestly, I stopped examining your code after I saw that initial error.

Waiiit... The value is multiplied by 4?! Woops... That's the ptr size right?

I used the vtable order from here: https://sourcegraph.com/github.com/g...enumvariant.go

I have no clue how to get the real vtable order to be honest, other than from looking at other existing source code...

Edit: Mhm I see now, so given this is the vtable order:

type IEnumVARIANTVtbl struct {
    IUnknownVtbl
    Next  uintptr
    Skip  uintptr
    Reset uintptr
    Clone uintptr
}

The method is at position 4 correct so to translate this to the VTable location I guess each pointer is 4 bytes long, so we do (4-1)*4 as the vTable offset?

Edit: I've changed that and I'm still getting all the crashes sadly... Damn I wish it errored and didn't just crash on me...

[LaVolpe]

Here are some threads that may help?
https://www.vbforums.com/showthread....hout-a-typelib
https://www.vbforums.com/showthread....BaseInterfaces
http://computer-programming-forum.co...9194f32d80.htm
http://www.equestionanswers.com/com-...-interface.php

[The trick]

FYI you can use __vbaForEachCollVar and __vbaNextEachCollVar functions as well.

[sancarn]

FYI you can use __vbaForEachCollVar and __vbaNextEachCollVar functions as well.

I had wondered about that, but do you know the declaration specification?

[sancarn]

So in the end I didn't really come up with a proper solution but I did come up with a solution which is ridiculously ugly but works for what I needed...

Behold, the behemoth:

Sub t()
    Dim c As Collection
    Set c = New Collection
    c.Add "a"
    c.Add "b"
    c.Add "c"
    
    Do While True
        Dim iterated As Variant
        
        Select Case iMode
            Case 1
                Dim initialised As Boolean
                If Not initialised Then
                    GoSub InitIEnumVARIANT
                Else
                    GoSub NextItem
                End If
            Case 2
                '...
            Case 3
                '...
        End Select
        if isNull(iterated) then Exit Sub
        
        'Rest of the loop
    Loop
    
    Exit Sub
InitIEnumVARIANT:
    initialised = True
    For Each iterated In c
        Return
NextItem:
    Next
    iterated = Null
    Return
End Sub

Note: I'm pretty surprised this actually worked to be honest...

I did try to segregate the code to a function:

Private Function vbNext(Optional ByVal oCaller As Object = Nothing) As Variant
    If oCaller Is Nothing Then GoTo GoTo1
    Static pCaller As Object: Set pCaller = oCaller
    Static x As Variant
    For Each x In pCaller
        Call CopyVariant(vbNext, x)
        GoTo GoTo2
GoTo1:
    Next
    vbNext = Null
GoTo2:
End Function

I thought this would work, but turns out the for-each progress gets lost when leaving the function, which to be fair isn't too surprising. The whole stack gets popped after all...

Anyway, that's my filthy function. In fairness it has it's benefits, it's cross-platform compatable, and lack of dlls is good sometimes I guess... Thanks all for the help and ideas

[The trick]

Option Explicit

Private Const CC_STDCALL    As Long = 4

Private Declare Function DispCallFunc Lib "oleaut32.dll" ( _
                         ByRef pvInstance As Any, _
                         ByVal oVft As Long, _
                         ByVal cc As Long, _
                         ByVal vtReturn As VbVarType, _
                         ByVal cActuals As Long, _
                         ByRef prgvt As Any, _
                         ByRef prgpvarg As Any, _
                         ByRef pvargResult As Variant) As Long
                         
Private Sub Form_Load()
    Dim cCol        As Collection
    Dim cEnum       As IUnknown
    Dim vItem       As Variant
    Dim lFetched    As Long
    
    Set cCol = New Collection
    
    cCol.Add 4
    cCol.Add 3
    cCol.Add 2
    cCol.Add 1
    
    Set cEnum = cCol.[_NewEnum]

    Do While IEnumVariant_Next(cEnum, 1, vItem, lFetched) = 0
        
        Debug.Print vItem
        
        vItem = Empty
        
    Loop
    
End Sub

Private Function IEnumVariant_Next( _
                 ByVal cEnum As IUnknown, _
                 ByVal celt As Long, _
                 ByRef rgVar As Variant, _
                 ByRef pCeltFetched As Long) As Long
    Dim iTypes(2)   As Integer
    Dim pArgs(2)    As Long
    Dim vArgs(2)    As Variant
    Dim hr          As Long
    Dim vRet        As Variant
    
    vArgs(0) = celt: vArgs(1) = VarPtr(rgVar): vArgs(2) = VarPtr(pCeltFetched)
    iTypes(0) = vbLong: iTypes(1) = vbObject: iTypes(2) = vbObject  ' // vbObject - pointer type
    pArgs(0) = VarPtr(vArgs(0)): pArgs(1) = VarPtr(vArgs(1)): pArgs(2) = VarPtr(vArgs(2))
    
    hr = DispCallFunc(ByVal ObjPtr(cEnum), &HC, CC_STDCALL, vbLong, 3, iTypes(0), pArgs(0), vRet)
    
    If hr < 0 Then
        Err.Raise hr
    End If
    
    IEnumVariant_Next = vRet
    
End Function

[The trick]

Option Explicit

Private Declare Function vbaForEachCollVar Lib "msvbvm60" Alias "__vbaForEachCollVar" ( _
                         ByRef cEnum As IUnknown, _
                         ByRef vItem As Variant, _
                         ByVal cColl As Object) As Long
Private Declare Function vbaNextEachCollVar Lib "msvbvm60" Alias "__vbaNextEachCollVar" ( _
                         ByRef cEnum As IUnknown, _
                         ByRef vItem As Variant) As Long
Private Sub Form_Load()
    Dim cCol        As Collection
    Dim vItem       As Variant
    Dim cEnum       As IUnknown
    
    Set cCol = New Collection
    
    cCol.Add 4
    cCol.Add 3
    cCol.Add 2
    cCol.Add 1

    If vbaForEachCollVar(cEnum, vItem, cCol) Then
        Do
            Debug.Print vItem
        Loop While vbaNextEachCollVar(cEnum, vItem)
    End If
    
End Sub

[wqweto]

Wow, this is too good not to mix both like this

Option Explicit

Private Declare Function vbaNextEachCollVar Lib "msvbvm60" Alias "__vbaNextEachCollVar" ( _
                         ByRef pEnum As IUnknown, _
                         ByRef vItem As Variant) As Long
                         
Private Sub Form_Load()
    Dim cCol        As Collection
    Dim vItem       As Variant
    Dim pEnum       As IUnknown
    
    Set cCol = New Collection
    
    cCol.Add 4
    cCol.Add 3
    cCol.Add 2
    cCol.Add 1
    
    Set pEnum = cCol.[_NewEnum]
    Do While vbaNextEachCollVar(pEnum, vItem)
        Debug.Print vItem
    Loop
End Sub

cheers,
</wqw>

[The trick]

wqweto, not all the interfaces has the accessible _NewEnum property. For example an array of controls or scrrun.Dictionary.

[wqweto]

Sure!

__vbaForEachCollVar obviously does the heavy-lifting of calling DISPID_NEWENUM on the IDispatch to return the IEnumVARIANT. No one asked it to call Next too on this interface though (but probably the compiler designers had they reasons)

cheers,
</wqw>

[sancarn]

Option Explicit

Private Declare Function vbaForEachCollVar Lib "msvbvm60" Alias "__vbaForEachCollVar" ( _
                         ByRef cEnum As IUnknown, _
                         ByRef vItem As Variant, _
                         ByVal cColl As Object) As Long
Private Declare Function vbaNextEachCollVar Lib "msvbvm60" Alias "__vbaNextEachCollVar" ( _
                         ByRef cEnum As IUnknown, _
                         ByRef vItem As Variant) As Long
Private Sub Form_Load()
    Dim cCol        As Collection
    Dim vItem       As Variant
    Dim cEnum       As IUnknown
    
    Set cCol = New Collection
    
    cCol.Add 4
    cCol.Add 3
    cCol.Add 2
    cCol.Add 1

    If vbaForEachCollVar(cEnum, vItem, cCol) Then
        Do
            Debug.Print vItem
        Loop While vbaNextEachCollVar(cEnum, vItem)
    End If
    
End Sub

Wowee! Now I'm gutted I can't seem to use these APIs in VBA... They seem to be weirdly embedded in the VBE7.dll but not accessible... And for whatever reason that means I can't import them from msvbvm60 also... Perhaps they are actually accessible via Ordinal, I did start decompiling VBE7.dll to see if I could find the offset but didn't manage in the end... Thanks also for completing the DispCallFunc approach though! Mega helpful and actually clean too! I think I'll end up sticking with that approach for now