问题
I have found a bug in VBA a few months ago and was unable to find a decent workaround. The bug is really annoying as it kind of restricts a nice language feature.
When using a Custom Collection Class it is quite common to want to have an enumerator so that the class can be used in a For Each
loop. This can be done by adding this line:
Attribute [MethodName].VB_UserMemId = -4 'The reserved DISPID_NEWENUM
immediately after the function/property signature line either by:
- Exporting the class module, editing the contents in a text editor, and then importing back
- Using Rubberduck annotation
'@Enumerator
above the function signature and then syncronizing
Unfortunately, on x64, using the above-mentioned feature, causes the wrong memory to get written and leads to the crash of the Application in certain cases (discussed later).
Reproducing the bug
CustomCollection
class:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CustomCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private m_coll As Collection
Private Sub Class_Initialize()
Set m_coll = New Collection
End Sub
Private Sub Class_Terminate()
Set m_coll = Nothing
End Sub
Public Sub Add(v As Variant)
m_coll.Add v
End Sub
Public Function NewEnum() As IEnumVARIANT
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = m_coll.[_NewEnum]
End Function
Code in a standard module:
Option Explicit
Sub Main()
#If Win64 Then
Dim c As New CustomCollection
c.Add 1
c.Add 2
ShowBug c
#Else
MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"
#End If
End Sub
Sub ShowBug(c As CustomCollection)
Dim ptr0 As LongPtr
Dim ptr1 As LongPtr
Dim ptr2 As LongPtr
Dim ptr3 As LongPtr
Dim ptr4 As LongPtr
Dim ptr5 As LongPtr
Dim ptr6 As LongPtr
Dim ptr7 As LongPtr
Dim ptr8 As LongPtr
Dim ptr9 As LongPtr
'
Dim v As Variant
'
For Each v In c
Next v
Debug.Assert ptr0 = 0
End Sub
By running the Main
method, the code will stop on the Assert
line in the ShowBug
method and you can see in the Locals window that local variables got their values changed out of nowhere:
where ptr1 is equal to ObjPtr(c)
. The more variables are used inside the NewEnum
method (including Optional parameters) the more ptrs in the ShowBug
method get written with a value (memory address).
Needless to say, removing the local ptr variables inside the ShowBug
method would most certainly cause the crash of the Application.
When stepping through code line by line, this bug will not occur!
More on the bug
The bug is not related with the actual Collection
stored inside the CustomCollection
. The memory gets written immediately after the NewEnum function is invoked. So, basically doing any of the following is not helping (tested):
- adding
Optional
parameters - removing all code from within the function (see below code showing this)
- declaring as
IUnknown
instead ofIEnumVariant
- instead of
Function
declaring asProperty Get
- using keywords like
Friend
orStatic
in the method signature - adding the DISPID_NEWENUM to a Let or Set counterpart of the Get, or even hiding the former (i.e. make the Let/Set private).
Let us try step 2 mentioned above. If CustomCollection
becomes:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CustomCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Function NewEnum() As IEnumVARIANT
Attribute NewEnum.VB_UserMemId = -4
End Function
and the code used for testing is changed to:
Sub Main()
#If Win64 Then
Dim c As New CustomCollection
ShowBug c
#Else
MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"
#End If
End Sub
Sub ShowBug(c As CustomCollection)
Dim ptr0 As LongPtr
Dim ptr1 As LongPtr
Dim ptr2 As LongPtr
Dim ptr3 As LongPtr
Dim ptr4 As LongPtr
Dim ptr5 As LongPtr
Dim ptr6 As LongPtr
Dim ptr7 As LongPtr
Dim ptr8 As LongPtr
Dim ptr9 As LongPtr
'
Dim v As Variant
'
On Error Resume Next
For Each v In c
Next v
On Error GoTo 0
Debug.Assert ptr0 = 0
End Sub
running Main
produces the same bug.
Workaround
Reliable ways, that I found, to avoid the bug:
Call a method (basically leave the
ShowBug
method) and come back. This needs to happen before theFor Each
line is executed (before meaning it can be anywhere in the same method, not necessarily the exact line before):Sin 0 'Or VBA.Int 1 - you get the idea For Each v In c Next v
Cons: Easy to forget
Do a
Set
statement. It could be on the variant used in the loop (if no other objects are used). As in point 1 above, this needs to happen before theFor Each
line is executed:Set v = Nothing For Each v In c Next v
or even by setting the collection to itself with
Set c = c
Or, passing the c parameterByVal
to theShowBug
method (which, as Set, does a call to IUnknown::AddRef)
Cons: Easy to forgetUsing a separate
EnumHelper
class that is the only class ever used for enumerating:VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "EnumHelper" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Private m_enum As IEnumVARIANT Public Property Set EnumVariant(newEnum_ As IEnumVARIANT) Set m_enum = newEnum_ End Property Public Property Get EnumVariant() As IEnumVARIANT Attribute EnumVariant.VB_UserMemId = -4 Set EnumVariant = m_enum End Property
CustomCollection
would become:VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "CustomCollection" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Private m_coll As Collection Private Sub Class_Initialize() Set m_coll = New Collection End Sub Private Sub Class_Terminate() Set m_coll = Nothing End Sub Public Sub Add(v As Variant) m_coll.Add v End Sub Public Function NewEnum() As EnumHelper Dim eHelper As New EnumHelper ' Set eHelper.EnumVariant = m_coll.[_NewEnum] Set NewEnum = eHelper End Function
and the calling code:
Option Explicit Sub Main() #If Win64 Then Dim c As New CustomCollection c.Add 1 c.Add 2 ShowBug c #Else MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled" #End If End Sub Sub ShowBug(c As CustomCollection) Dim ptr0 As LongPtr Dim ptr1 As LongPtr Dim ptr2 As LongPtr Dim ptr3 As LongPtr Dim ptr4 As LongPtr Dim ptr5 As LongPtr Dim ptr6 As LongPtr Dim ptr7 As LongPtr Dim ptr8 As LongPtr Dim ptr9 As LongPtr ' Dim v As Variant ' For Each v In c.NewEnum Debug.Print v Next v Debug.Assert ptr0 = 0 End Sub
Obviously, the reserved DISPID was removed from the
CustomCollection
class.Pros: forcing the
For Each
on the.NewEnum
function instead of the custom collection directly. This avoids any crash caused by the bug.Cons: always needing the extra
EnumHelper
class. Easy to forget to add the.NewEnum
in theFor Each
line (would only trigger a runtime error).
The last approach (3) works because when c.NewEnum
is executed the ShowBug
method is exited and then returned before the invocation of the Property Get EnumVariant
inside the EnumHelper
class. Basically approach (1) is the one avoiding the bug.
What is the explanation for this behavior? Can this bug be avoided in a more elegant way?
EDIT
Passing the CustomCollection
ByVal is not always an option. Consider a Class1
:
Option Explicit
Private m_collection As CustomCollection
Private Sub Class_Initialize()
Set m_collection = New CustomCollection
End Sub
Private Sub Class_Terminate()
Set m_collection = Nothing
End Sub
Public Sub AddElem(d As Double)
m_collection.Add d
End Sub
Public Function SumElements() As Double
Dim v As Variant
Dim s As Double
For Each v In m_collection
s = s + v
Next v
SumElements = s
End Function
And now a calling routine:
Sub ForceBug()
Dim c As Class1
Set c = New Class1
c.AddElem 2
c.AddElem 5
c.AddElem 7
Debug.Print c.SumElements 'BOOM - Application crashes
End Sub
Obviously, the example is a bit forced but it is quite common to have a "parent" object containing a Custom Collection of "child" objects and the "parent" might want to do some operation involving some or all of the "children".
In this case it would be easy to forget to do a Set
statement or a method call before the For Each
line.
回答1:
What is happening
It appears that the stack frames are overlapping although they should not. Having enough variables in the ShowBug
method prevents a crash and the values of the variables (in the caller subroutine) are simply changed because the memory they refer to is also used by another stack frame (the called subroutine) that was added/pushed later at the top of the call stack.
We can test this by adding a couple of Debug.Print
statements to the same code from the question.
The CustomCollection
class:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CustomCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private m_coll As Collection
Private Sub Class_Initialize()
Set m_coll = New Collection
End Sub
Private Sub Class_Terminate()
Set m_coll = Nothing
End Sub
Public Sub Add(v As Variant)
m_coll.Add v
End Sub
Public Function NewEnum() As IEnumVARIANT
Attribute NewEnum.VB_UserMemId = -4
Debug.Print "The NewEnum return address " & VarPtr(NewEnum) & " should be outside of the"
Set NewEnum = m_coll.[_NewEnum]
End Function
And the calling code, in a standard .bas module:
Option Explicit
Sub Main()
#If Win64 Then
Dim c As New CustomCollection
c.Add 1
c.Add 2
ShowBug c
#Else
MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"
#End If
End Sub
Sub ShowBug(ByRef c As CustomCollection)
Dim ptr0 As LongPtr
Dim ptr1 As LongPtr
Dim ptr2 As LongPtr
Dim ptr3 As LongPtr
Dim ptr4 As LongPtr
Dim ptr5 As LongPtr
Dim ptr6 As LongPtr
Dim ptr7 As LongPtr
Dim ptr8 As LongPtr
Dim ptr9 As LongPtr
'
Dim v As Variant
'
For Each v In c
Next v
Debug.Print VarPtr(ptr9) & " - " & VarPtr(ptr0) & " memory range"
Debug.Assert ptr0 = 0
End Sub
By running Main
I get something like this in the Immediate Window:
The address of the NewEnum
return value is clearly at a memory address in between the ptr0
and ptr9
variables of the ShowBug
method. So, that is why the variables get values out of nowhere, because they actually come from the stack frame of the NewEnum
method (like the address of the object's vtable or the address of the IEnumVariant
interface). If the variables would not be there, then the crash is obvious as more critical parts of memory are being overwritten (e.g. the frame pointer address for the ShowBug
method). As the stack frame for the NewEnum
method is larger (we can add local variables for example, to increase the size), the more memory is shared between the top stack frame and the one below in the call stack.
What happens if we workaround the bug with the options described in the question? Simply adding a Set v = Nothing
before the For Each v In c
line, results into:
Showing both previous value and the current one (bordered blue), we can see that the NewEnum
return is at a memory address outside of the ptr0
and ptr9
variables of the ShowBug
method. It seems that the stack frame was correctly allocated using the workaround.
If we break inside the NewEnum
the call stack looks like this:
How For Each
invokes NewEnum
Every VBA class is derived from IDispatch (which in turn is derived from IUnknown).
When a For Each...
loop is called on an object, that object's IDispatch::Invoke
method is called with a dispIDMember
equal to -4. A VBA.Collection already has such a member but for VBA custom classes we mark our own method with Attribute NewEnum.VB_UserMemId = -4
so that Invoke can call our method.
Invoke
is not called directly if the interface used in the For Each
line is not derived from IDispatch
. Instead, IUnknown::QueryInterface
is called first and asked for the IDispatch interface. In this case Invoke
is obviously called
only after IDispatch interface is returned. Right here is the reason why using For Each
on an Object declared As IUnknown
will not cause the bug regardless if it is passed ByRef
or if it is a global or class member custom collection. It simply uses workaround number 1 mentioned in the question (i.e. calls another method) although we cannot see it.
Hooking Invoke
We can replace the non-VB Invoke
method with one of our own in order to investigate further. In a standard .bas
module we need the following code to hook:
Option Explicit
#If Mac Then
#If VBA7 Then
Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr
#Else
Private Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long
#End If
#Else 'Windows
'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
#End If
#If Win64 Then
Private Const PTR_SIZE As Long = 8
#Else
Private Const PTR_SIZE As Long = 4
#End If
#If VBA7 Then
Private newInvokePtr As LongPtr
Private oldInvokePtr As LongPtr
Private invokeVtblPtr As LongPtr
#Else
Private newInvokePtr As Long
Private oldInvokePtr As Long
Private invokeVtblPtr As Long
#End If
'https://docs.microsoft.com/en-us/windows/win32/api/oaidl/nf-oaidl-idispatch-invoke
Function IDispatch_Invoke(ByVal this As Object _
, ByVal dispIDMember As Long _
, ByVal riid As LongPtr _
, ByVal lcid As Long _
, ByVal wFlags As Integer _
, ByVal pDispParams As LongPtr _
, ByVal pVarResult As LongPtr _
, ByVal pExcepInfo As LongPtr _
, ByRef puArgErr As Long _
) As Long
Const DISP_E_MEMBERNOTFOUND = &H80020003
'
Debug.Print "The IDispatch::Invoke return address " & VarPtr(IDispatch_Invoke) & " should be outside of the"
IDispatch_Invoke = DISP_E_MEMBERNOTFOUND
End Function
Sub HookInvoke(obj As Object)
If obj Is Nothing Then Exit Sub
#If VBA7 Then
Dim vTablePtr As LongPtr
#Else
Dim vTablePtr As Long
#End If
'
newInvokePtr = VBA.Int(AddressOf IDispatch_Invoke)
CopyMemory vTablePtr, ByVal ObjPtr(obj), PTR_SIZE
'
invokeVtblPtr = vTablePtr + 6 * PTR_SIZE
CopyMemory oldInvokePtr, ByVal invokeVtblPtr, PTR_SIZE
CopyMemory ByVal invokeVtblPtr, newInvokePtr, PTR_SIZE
End Sub
Sub RestoreInvoke()
If invokeVtblPtr = 0 Then Exit Sub
'
CopyMemory ByVal invokeVtblPtr, oldInvokePtr, PTR_SIZE
invokeVtblPtr = 0
oldInvokePtr = 0
newInvokePtr = 0
End Sub
and we run the Main2
method (standard .bas module) to produce the bug:
Option Explicit
Sub Main2()
#If Win64 Then
Dim c As Object
Set c = New CustomCollection
c.Add 1
c.Add 2
'
HookInvoke c
ShowBug2 c
RestoreInvoke
#Else
MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"
#End If
End Sub
Sub ShowBug2(ByRef c As CustomCollection)
Dim ptr00 As LongPtr
Dim ptr01 As LongPtr
Dim ptr02 As LongPtr
Dim ptr03 As LongPtr
Dim ptr04 As LongPtr
Dim ptr05 As LongPtr
Dim ptr06 As LongPtr
Dim ptr07 As LongPtr
Dim ptr08 As LongPtr
Dim ptr09 As LongPtr
Dim ptr10 As LongPtr
Dim ptr11 As LongPtr
Dim ptr12 As LongPtr
Dim ptr13 As LongPtr
Dim ptr14 As LongPtr
Dim ptr15 As LongPtr
Dim ptr16 As LongPtr
Dim ptr17 As LongPtr
Dim ptr18 As LongPtr
Dim ptr19 As LongPtr
'
Dim v As Variant
'
On Error Resume Next
For Each v In c
Next v
Debug.Print VarPtr(ptr19) & " - " & VarPtr(ptr00) & " range on the call stack"
Debug.Assert ptr00 = 0
End Sub
Notice that more dummy ptr variables are needed to prevent the crash as the stack frame for IDispatch_Invoke
is bigger (hence, the memory overlap is bigger).
By running the above, I get:
The same bug occurs although the code never reaches the NewEnum
method due to the hooking of the Invoke
method. The stack frame is again wrongfully allocated.
Again, adding a Set v = Nothing
before the For Each v In c
results into:
The stack frame is allocated correctly (bordered green). This indicates that the issue is not with the NewEnum
method and also not with our replacement Invoke
method. Something is happening before our Invoke
is called.
If we break inside our IDispatch_Invoke
the call stack looks like this:
One last example. Consider a blank (with no code) class Class1
. If we run Main3
in the following code:
Option Explicit
Sub Main3()
#If Win64 Then
Dim c As New Class1
ShowBug3 c
#Else
MsgBox "This bug does not occur on 32 bits!", vbInformation, "Cancelled"
#End If
End Sub
Sub ShowBug3(ByRef c As Class1)
Dim ptr0 As LongPtr
Dim ptr1 As LongPtr
Dim ptr2 As LongPtr
Dim ptr3 As LongPtr
Dim ptr4 As LongPtr
Dim ptr5 As LongPtr
Dim ptr6 As LongPtr
Dim ptr7 As LongPtr
Dim ptr8 As LongPtr
Dim ptr9 As LongPtr
'
Dim v As Variant
'
On Error Resume Next
For Each v In c
Next v
Debug.Assert ptr0 = 0
End Sub
The bug simply does not occur. How is this different from running Main2
with our own hooked Invoke
? In both cases DISP_E_MEMBERNOTFOUND
is returned and no NewEnum
method is called.
Well, if we look at the previously shown call stacks side by side:
we can see that the non-VB Invoke
is not pushed on the VB stack as a separate "Non-Basic Code" entry.
Apparently, the bug only occurs if a VBA method is called (either NewEnum via the original non-VB Invoke or our own IDispatch_Invoke). If a non-VB method is called (like the original IDispatch::Invoke with no following NewEnum) the bug does not occur as in Main3
above. No bug occurs when running For Each...
on a VBA Collection within the same circumstances either.
The bug cause
As all the above examples suggest, the bug can be summarized with the following:For Each
calls IDispatch::Invoke
which in turn calls NewEnum
while the stack pointer has not been incremented with the size of the ShowBug
stack frame. Hence, same memory is used by both frames (the caller ShowBug
and the callee NewEnum
).
Workarounds
Ways to force the correct incrementation of the stack pointer:
- call another method directly (before the
For Each
line) e.g.Sin 1
- call another method indirectly (before the
For Each
line):- a call to
IUnknown::AddRef
by passing the argumentByVal
- a call to
IUnknown::QueryInterface
by using thestdole.IUnknown
interface - using a
Set
statement which will call eitherAddRef
orRelease
or both (e.g.Set c = c
). Could also callQueryInterface
depending on the source and target interfaces
- a call to
As suggested in the EDIT section of the question, we don't always have the possibility to pass the Custom Collection class ByVal
because it could simply be a global variable, or a class member and we would need to remember to do a dummy Set
statement or to call another method before For Each...
is executed.
Solution
I still could not find a better solution that the one presented in the question, so I am just going to replicate the code here as part of the answer, with a slight tweak.
EnumHelper
class:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "EnumHelper"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private m_enum As IEnumVARIANT
Public Property Set EnumVariant(newEnum_ As IEnumVARIANT)
Set m_enum = newEnum_
End Property
Public Property Get EnumVariant() As IEnumVARIANT
Attribute EnumVariant.VB_UserMemId = -4
Set EnumVariant = m_enum
End Property
Public Property Get Self() As EnumHelper
Set Self = Me
End Property
CustomCollection
would now become something like:
Option Explicit
Private m_coll As Collection
Private Sub Class_Initialize()
Set m_coll = New Collection
End Sub
Private Sub Class_Terminate()
Set m_coll = Nothing
End Sub
Public Sub Add(v As Variant)
m_coll.Add v
End Sub
Public Function NewEnum() As EnumHelper
With New EnumHelper
Set .EnumVariant = m_coll.[_NewEnum]
Set NewEnum = .Self
End With
End Function
You would just need to call with For Each v in c.NewEnum
Although, the EnumHelper
class would be an extra class needed in any project implementing a custom collection class, there are a couple of advantages as well:
- You would never need to add the
Attribute [MethodName].VB_UserMemId = -4
to any other custom collection class. This is even more useful for users that do not have RubberDuck installed ('@Enumerator
annotation), as they would need to export, edit the .cls text file and import back for each custom collection class - You could expose multiple EnumHelpers for the same class. Consider a custom dictionary class. You could have an
ItemsEnum
and aKeysEnum
at the same time. BothFor Each v in c.ItemsEnum
andFor Each v in c.KeysEnum
would work - You would never forget to use one of the workarounds presented above as the method exposing the
EnumHelper
class would be called beforeInvoke
is calling member ID -4 - You would not get crashes anymore. If you forget to call with
For Each v in c.NewEnum
and instead useFor Each v in c
you would just get a runtime error which would be picked up in testing anyway. Of course you could still force a crash by passing the result ofc.NewEnum
to another methodByRef
which would then need to execute aFor Each
before any other method call orSet
statement. Highly unlikely you would ever do that - Obvious but worth mentioning, you would use the same
EnumHelper
class for all the custom collection classes you might have in a project
来源:https://stackoverflow.com/questions/63848617/bug-with-for-each-enumeration-on-x64-custom-classes