In VBA, if you want an iterable Range object like in Python, you do something like this. However that approach involves building the entire range in one go:
Set mCollection = New Collection Dim i As Long For i = startValue To endValue mCollection.Add i Next
...which is bad if you want to make a really big range, as it takes ages and a lot of memory to build that collection. That's what generators are for; they generate the next item in the sequence as you loop.
Now if you want a class to be iterable, it has to return a [_NewEnum], which is done with the Set keyword. That tells me that a For...Each loop only requires a reference to an Enum, since the Set keyword only assigns pointers to a returned variable, rather than the actual value.
That gives scope for a bit of juggling:
For...Each(henceforth "the Iterator") requires bit of memory that gives directions to the supplied[_NewEnum]; a reference to the enum object's pointer- A custom class can generate a
[_NewEnum]pointer from an encapsulated collection whenever it wants - Perhaps therefore, if the class knows where in memory the Iterator is looking for the enum pointer, it can overwrite that bit of memory with a pointer to a different enum object altogether.
In other words:
- In the first iteration of a
For...Eachloop, my class returns a variable whose value is the pointer to one Enum. The variable resides in memory at a location given byVarPtr(theVariable) - The next iteration, I manually call a method of my class which generates a second Enum
- After that the method continues by overwriting the first enum object's pointer at the address given by the variable pointer, and replaces it with the
ObjPtr()of the second enum.
If that theory is correct, then the For Each loop would now hold a reference to a different value for [_NewEnum], so would do something different.
Here's how I tried to do it:
The generator: NumberRange Class Module
Note: must be imported to preserve attributes.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "NumberRange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Type TRange
encapsulated As Collection
isGenerator As Boolean
currentCount As Long
maxCount As Long
currentEnum As IUnknown
End Type
Private this As TRange
Public Sub fullRange(ByVal count As Long)
'generate whole thing at once
Dim i As Long
this.isGenerator = False
For i = 1 To count
this.encapsulated.Add i
Next i
End Sub
Public Sub generatorRange(ByVal count As Long)
'generate whole thing at once
this.isGenerator = True
this.currentCount = 1
this.maxCount = count
this.encapsulated.Add this.currentCount 'initial value for first enumeration
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_UserMemId = -4
Set this.currentEnum = this.encapsulated.[_NewEnum]
Set NewEnum = this.currentEnum
End Property
Public Sub generateNext()
'This method is what should overwrite the current variable
If this.isGenerator And this.currentCount < this.maxCount Then
this.currentCount = this.currentCount + 1
replaceVal this.encapsulated, this.currentCount
updateObject VarPtr(this.currentEnum), this.encapsulated.[_NewEnum]
Else
Err.Raise 5, Description:="Method reserved for generators"
End If
End Sub
Private Sub Class_Initialize()
Set this.encapsulated = New Collection
End Sub
Private Sub replaceVal(ByRef col As Collection, ByVal newval As Long)
If col.count Then
col.Remove 1
End If
col.Add newval
End Sub
Contains a standard method for making the full thing in one go, or a generator method, to be used in conjunction with generateNext in the loop. Might be an off-by-one error in there but that's not important right now.
Memory management helper module
These methods have only been tested on my 32 bit system. Might work on both though (with the conditional compilation).
Option Explicit
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, _
source As Any, ByVal bytes As Long)
Public Sub updateObject(ByVal variableAddress As LongPtr, ByVal replacementObject As Variant)
#If VBA7 And Win64 Then
Const pointerLength As Byte = 8
#Else
Const pointerLength As Byte = 4
#End If
CopyMemory ByVal variableAddress, ObjPtr(replacementObject), pointerLength
End Sub
That last line is the important one; it says to copy the object pointer of the supplied object ObjPtr(replacementObject) to the location of a specific variable ByVal variableAddress, the ByVal here signalling that we're talking about the memory of the variable itself, not a reference to the variable. The fact that the variable already contains an object pointer doesn't matter
Test code
Sub testGenerator()
Dim g As New NumberRange
g.generatorRange 10
Dim val
For Each val In g
Debug.Print val
g.generateNext
Next val
End Sub
If it's working then this should print numbers 1 to 10. But right now it's getting out of the loop after one go.
So why isn't this working? I think I've followed all the steps I outlined. I think the memory updater is working as intended, but I'm not certain as I can't query the ObjPtr() of the enum which the Iterator is currently using. Perhaps For...Each just doesn't like being interrupted! Any thoughts on how to achieve the desired behaviour welcome!
Ps. Save often, watch out for crashes!
Bonus test method for the memory writer:
Public Sub testUpdater()
'initialise
Dim initialEnumeration As Object, newEnumeration As Object 'represent a [_NewEnum]
Set initialEnumeration = CreateObject("System.Collections.ArrayList")
Dim i As Long
For i = 1 To 5
initialEnumeration.Add i
Next i
'initialEnumeration pointers are what we want to change
iterateObjPrinting "initialEnumeration at Start:", initialEnumeration
'make some obvious change
Set newEnumeration = initialEnumeration.Clone()
newEnumeration(4) = 9
iterateObjPrinting "newEnumeration before any copy:", newEnumeration
'update the first one in place
updateObject VarPtr(initialEnumeration), newEnumeration
iterateObjPrinting "initialEnumeration after copy", initialEnumeration
End Sub
Private Sub iterateObjPrinting(ByVal message As String, ByVal obj As Variant)
Dim val, result As String
For Each val In obj
result = result & " " & val
Next val
Debug.Print message, Trim(result)
End Sub
