Metamorphing Machine I rather be this walking metamorphosis
than having that old formed opinion about everything!

Let's build a transpiler! Part 22

This is the twenty-second post in a series of building a transpiler.
You can find the previous ones here.

Last time I said we would delve deep into IEnumVARIANT interface.

Every time you For Each something,

For Each Month In Months
(...)
Next
VB compiles it with something (that may looks) like this.:

Dim Iterator As IEnumVARIANT
Dim Done As Long

Rem Months must implement IEnumVARIANT interface.
Rem Iterator has its reference count incremented in the call to [NewEnum].
Set Iterator = Months.NewEnum()

Do
If IsObject(Month) Then Set Month = Nothing Else Month = Empty

Rem The call to [Next] method below requests one element.
Rem Month is passed ByRef so it can be assigned with the next element in sequence.
Rem Done is also passed ByRef.
Iterator.Next 1, Month, Done

If Done = 1 Then
Rem Iterator's reference count is decremented.
Set Iterator = Nothing
Exit Do
End If
(...)
Loop
So, one is left to think that in order to For Each any VB6 class, we'll just have to slap an Implements IEnumVARIANT and implement its methods.
After all, there are only four of them: Clone, Next, Reset, and Skip.
Unfortunatelly, it is not that simple. IEnumVARIANT uses types that are not available to VB (unsigned longs and pointers). Its methods are not COM ones - they do not return HRESULTs -, so VB has no way to deal with them. It also has a method called Next, that's a VB keyword. So, no luck.

You can resort to external typelibs or use a Collection and delegate to its NewEnum method.

Some time ago I thought that I should try it the hard way. After a lot of trial and error (and some crashes) I managed to have something that is re-usable.
Also, it is really enlightning to run the code step-by-step inside VB's IDE.
It is comprised of two files, VariantEnumerator.cls and VariantEnumeratorHome.bas.
I won't explain them as they have pretty advanced stuff, but note that, having them in your VB project, you can make your class For Eachable.

First, VariantEnumerator.cls:

Option Explicit
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As LongPtr, ByVal dwFlags As Long, ByVal dwBytes As Long) As LongPtr

Public Event NextItem(ByVal Qty As Long, ByRef Items As Variant, ByRef Returned As Long, ByRef Data As Variant)
Public Event Skip(ByVal Qty As Long, ByRef Data As Variant)
Public Event Reset(ByRef Data As Variant)
Public Event Clone(ByRef Obj As Variant, ByRef Data As Variant)

Public Function NewEnum(ByVal ParentObj As Object) As IUnknown
Dim Ptr As LongPtr
Dim Obj As IEnumVariantType

IncRefCount ParentObj
Ptr = HeapAlloc(GetProcessHeap, dwFlags:=0, dwBytes:=Len(Obj))

With Obj
.VTable = Ptr + 4
.QueryInterface = GetProc(AddressOf QueryInterfaceEntry)
.AddRef = GetProc(AddressOf AddRefEntry)
.Release = GetProc(AddressOf ReleaseEntry)
.NextItem = GetProc(AddressOf NextEntry)
.Skip = GetProc(AddressOf SkipEntry)
.Reset = GetProc(AddressOf ResetEntry)
.Clone = GetProc(AddressOf CloneEntry)
.Count = 1
.Ptr = Ptr
.Ref = ObjPtr(Me)
.Parent = ObjPtr(ParentObj)
End With

Rem Copy structure to the allocated memory
CopyMemory Destination:=ByVal Ptr, Source:=VarPtr(Obj), Length:=Len(Obj)
Rem Return pointer as an IUnknown.
CopyMemory NewEnum, Source:=VarPtr(Ptr), Length:=Len(Ptr)
End Function

Friend Sub OnNextItem(ByVal Qty As Long, ByRef Items As Variant, ByRef Returned As Long, ByRef Data As Variant)
RaiseEvent NextItem(Qty, Items, Returned, Data)
End Sub

Friend Sub OnSkip(ByVal Qty As Long, ByRef Data As Variant)
RaiseEvent Skip(Qty, Data)
End Sub

Friend Sub OnReset(ByRef Data As Variant)
RaiseEvent Reset(Data)
End Sub

Friend Sub OnClone(ByRef Obj As Variant, ByRef Data As Variant)
RaiseEvent Clone(Obj, Data)
End Sub

Private Function GetProc(ByRef Proc As LongPtr) As LongPtr
GetProc = Proc
End Function

Private Sub IncRefCount(ByRef Obj As Object)
Dim Dummy As Object
Dim Nil As LongPtr

Set Dummy = Obj
CopyMemory Destination:=Dummy, Source:=VarPtr(Nil), Length:=Len(Nil)
End Sub
Second, VariantEnumeratorHome.bas:

Option Explicit
Option Private Module

Private Declare Function HeapFree Lib "kernel32" ( _
ByVal hHeap As LongPtr, _
ByVal dwFlags As Long, _
ByRef lpMem As LongPtr _
) As Long

Public Declare Function GetProcessHeap Lib "kernel32" () As LongPtr

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByVal Source As LongPtr, _
ByVal Length As Long _
)

Public Type IEnumVariantType
VTable As LongPtr 'Address of the "virtual table" below.
QueryInterface As LongPtr 'Interface IUnknown.
AddRef As LongPtr 'Interface IUnknown.
Release As LongPtr 'Interface IUnknown.
NextItem As LongPtr 'Interface IEnumVARIANT.
Skip As LongPtr 'Interface IEnumVARIANT.
Reset As LongPtr 'Interface IEnumVARIANT.
Clone As LongPtr 'Interface IEnumVARIANT.
Count As Long 'Reference counter.
Ptr As LongPtr 'Pointer to this structure's allocated memory.
Ref As LongPtr 'Reference to VariantEnumerator.
Data As Variant 'Container to user's data.
Parent As LongPtr 'Reference to object being iterated.
End Type

Public Function QueryInterfaceEntry(ByRef This As IEnumVariantType, ByVal iid As Long, ByRef ppvObject As Long) As Long
Rem Increment reference count.
This.Count = This.Count + 1

Rem Return pointer to IEnumVariantType structure.
ppvObject = VarPtr(This)
End Function

Public Function AddRefEntry(ByRef This As IEnumVariantType) As Long
Rem Increment reference count.
This.Count = This.Count + 1

Rem Return it.
AddRefEntry = This.Count
End Function

Public Function ReleaseEntry(ByRef This As IEnumVariantType) As Long
Rem Decrement reference count.
This.Count = This.Count - 1

Rem Return it.
ReleaseEntry = This.Count

Rem If there's no more references, deallocates IEnumVariantType's memory.
If This.Count = 0 Then
DecRefCount This.Parent
HeapFree GetProcessHeap, 0, This.Ptr
End If
End Function

Public Function NextEntry( _
ByRef This As IEnumVariantType, _
ByVal celt As Long, _
ByRef rgvar As Variant, _
ByVal pceltFetched As Long _
) As Long
If celt = 0 Then celt = 1
GetEnumerator(This.Ref).OnNextItem celt, rgvar, pceltFetched, This.Data

Rem If qunatity of returned items is lower than what has been asked, iteration is over.
If pceltFetched < celt Then NextEntry = 1
End Function

Public Function SkipEntry(ByRef This As IEnumVariantType, ByVal celt As Long) As Long
GetEnumerator(This.Ref).OnSkip celt, This.Data
End Function

Public Function ResetEntry(ByRef This As IEnumVariantType) As Long
GetEnumerator(This.Ref).OnReset This.Data
End Function

Public Function CloneEntry(ByRef This As IEnumVariantType, ByRef ppEnum As IEnumVARIANT) As Long
GetEnumerator(This.Ref).OnClone ppEnum, This.Data
End Function

Private Function GetEnumerator(ByRef Ptr As LongPtr) As VariantEnumerator
Dim Obj As VariantEnumerator
Dim Res As VariantEnumerator
Dim Nil As LongPtr

Rem Copy pointer to a temporary object.
CopyMemory Destination:=Obj, Source:=VarPtr(Ptr), Length:=Len(Ptr)

Rem Get the legal object.
Set Res = Obj

Rem Free the ilegal object.
CopyMemory Destination:=Obj, Source:=VarPtr(Nil), Length:=Len(Nil)

Rem Return the "rehydrated" object.
Set GetEnumerator = Res
End Function

Private Sub DecRefCount(ByRef Ptr As LongPtr)
Dim Dummy As Object

CopyMemory Destination:=ObjPtr(Dummy), Source:=Ptr, Length:=Len(Ptr)
End Sub
We'll see an example of using it next week.

Andrej Biasic
2020-12-23