在x64自定义类上的ForEach枚举存在错误。
在x64自定义类上的ForEach枚举存在错误。
几个月前我发现了VBA中的一个错误，并且无法找到一个合适的解决方法。这个错误非常令人恼火，因为它限制了一个很好的语言特性。在使用自定义集合类时，通常希望有一个枚举器，以便可以在“For Each”循环中使用该类。可以通过在函数/属性签名行之后立即添加以下行来实现：
Attribute [MethodName].VB_UserMemId = -4 'The reserved DISPID_NEWENUM
通过以下两种方式之一来实现：
1. 将类模块导出，使用文本编辑器编辑内容，然后重新导入
2. 使用Rubberduck注释“'@Enumerator”在函数签名之前，然后进行同步
不幸的是，在x64上使用上述功能会导致错误的内存被写入，并在某些情况下导致应用程序崩溃（稍后讨论）。
复制错误
CustomCollection类：
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
标准模块中的代码：
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
通过运行“Main”方法，代码将停在“ShowBug”方法中的“Assert”行上，并且您可以在Locals窗口中看到局部变量的值在某处被更改：
图像：
当ptr1等于ObjPtr(c)时。在“NewEnum”方法内使用更多变量（包括可选参数）时，“ShowBug”方法中的ptrs会被写入一个值（内存地址）。
不用说，删除“ShowBug”方法中的局部ptr变量几乎肯定会导致应用程序崩溃。
在逐行执行代码时，不会发生此错误！
更多关于错误的信息
该错误与实际存储在“CustomCollection”中的“Collection”不相关。在调用“NewEnum”函数后立即写入内存。因此，基本上执行以下任何操作都无济于事（经过测试）：
添加“Optional”参数
从函数内部删除所有代码（参见下面的代码）
将其声明为“IUnknown”而不是“IEnumVariant”
将其声明为“Property Get”而不是“Function”
在方法签名中使用关键字“Friend”或“Static”
将DISPID_NEWENUM添加到Get的Let或Set副本，甚至隐藏前者（即使使Let/Set成为私有）。
让我们尝试上述提到的步骤2。如果“CustomCollection”变成：
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
并且用于测试的代码更改为：
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
运行“Main”会产生相同的错误。
解决方法
我找到的可靠方法来避免此错误：
调用一个方法（基本上离开“ShowBug”方法）并返回。这需要在执行“For Each”行之前发生（在同一方法中的任何位置，不一定是之前的确切行）：
Sin 0 'Or VBA.Int 1 - you get the idea
For Each v In c
Next v
缺点：容易忘记
进行一个“Set”语句。它可以在循环中使用的变量上（如果没有其他对象使用）。与上述第1点类似，这需要在执行“For Each”行之前发生：
Set v = Nothing
For Each v In c
Next v
或者甚至通过使用“Set c = c”将集合设置为其自身。
或者，将“c”参数作为“ByVal”传递给“ShowBug”方法（与Set一样，它调用IUnknown :: AddRef）
缺点：容易忘记
使用一个单独的“EnumHelper”类，该类是唯一用于枚举的类：
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”将变为：
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
调用代码：
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
显然，从“CustomCollection”类中删除了保留的DISPID。
优点：强制在“For Each”中使用“.NewEnum”函数，而不是直接使用自定义集合。这避免了由错误引起的任何崩溃。
缺点：始终需要额外的“EnumHelper”类。容易忘记在“For Each”行中添加“.NewEnum”（只会触发运行时错误）。
最后一种方法（3）之所以有效，是因为在执行“c.NewEnum”时，退出并返回了“ShowBug”方法，然后在“EnumHelper”类中的“Property Get EnumVariant”调用之前。基本上，方法（1）是避免错误的方法。
对于这种行为的解释是什么？有没有更优雅的方法来避免这个错误？
编辑
将“CustomCollection”按值传递并不总是一个选项。考虑一个“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
现在是一个调用例程：
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
显然，这个例子有点迫使，但是在一个“父”对象中包含一个“子”对象的自定义集合是很常见的，而且“父”可能希望对一些或所有“子”进行一些操作。
在这种情况下，很容易忘记在“For Each”行之前进行“Set”语句或方法调用。
Bug with For Each enumeration on x64 Custom Classes
最近在使用x64平台上的自定义类时，发现了一个严重的bug。当使用For Each枚举自定义类时，堆栈帧出现了重叠，尽管它们不应该重叠。当在ShowBug方法中添加足够多的变量时，可以防止崩溃，并且调用子例程中的变量值会发生改变，因为它们引用的内存也被另一个堆栈帧（调用的子例程）使用，该堆栈帧稍后被添加/推送到调用堆栈的顶部。
我们可以通过在问题中添加几个Debug.Print语句来测试这一点。
CustomCollection类：
（此处省略代码）
调用代码，位于标准的.bas模块中：
（此处省略代码）
通过运行Main，我在即时窗口中得到了以下输出：
（此处省略截图）
NewEnum返回值的地址明显位于ShowBug方法的ptr0和ptr9变量之间的内存地址。因此，变量的值是从堆栈帧的NewEnum方法（如对象的vtable地址或IEnumVariant接口的地址）中获取的。如果变量不存在，那么崩溃就很明显，因为会覆盖内存的更关键部分（例如ShowBug方法的帧指针地址）。由于NewEnum方法的堆栈帧较大（例如，我们可以添加局部变量来增加大小），因此顶部堆栈帧与下面的堆栈帧之间共享的内存就越多。
如果我们使用问题中描述的选项来解决bug，即在For Each v In c之前添加Set v = Nothing，会得到以下输出：
（此处省略截图）
将上一个值和当前值（带有蓝色边框）显示出来，我们可以看到NewEnum返回值位于ShowBug方法的ptr0和ptr9变量之外的内存地址。看来使用这种解决方法时，堆栈帧被正确分配了。
如果我们在NewEnum中断点，调用堆栈如下所示：
（此处省略截图）
For Each如何调用NewEnum
每个VBA类都派生自IDispatch（它本身派生自IUnknown）。
当在对象上调用For Each循环时，该对象的IDispatch::Invoke方法会被调用，其中dispIDMember等于-4。VBA.Collection已经有这样一个成员，但是对于VBA自定义类，我们使用Attribute NewEnum.VB_UserMemId = -4标记自己的方法，以便Invoke可以调用我们的方法。
如果在For Each行中使用的接口没有派生自IDispatch，则不会直接调用Invoke。首先调用IUnknown::QueryInterface，并要求获取IDispatch接口。在这种情况下，只有在返回IDispatch接口后才会明显调用Invoke。
挂钩Invoke
我们可以用我们自己的方法替换非VB Invoke方法，以进一步调查问题。在标准.bas模块中，我们需要以下代码来挂钩：
（此处省略代码）
通过运行Main2方法（标准.bas模块）来产生bug：
（此处省略代码）
通过以上操作，我得到了以下输出：
（此处省略截图）
尽管代码从未到达NewEnum方法，因为我们钩住了Invoke方法，但是堆栈帧仍然被错误地分配了。
同样，在For Each v In c之前添加Set v = Nothing会得到以下输出：
（此处省略截图）
堆栈帧被正确地分配（绿色边框）。这表明问题不在于NewEnum方法，也不在于我们自己的替代Invoke方法。在我们的Invoke被调用之前，发生了一些事情。
如果我们在IDispatch_Invoke中断点，调用堆栈如下所示：
（此处省略截图）
最后一个示例。考虑一个空白的（没有代码的）Class1类。如果我们在以下代码中运行Main3：
（此处省略代码）
这个bug根本不会发生。这与使用我们自己的挂钩Invoke运行Main2有什么不同？在这两种情况下，都返回了DISP_E_MEMBERNOTFOUND，并且没有调用NewEnum方法。
好吧，如果我们将之前显示的调用堆栈并排放置：
（此处省略截图）
我们可以看到非VB Invoke没有作为单独的“非基本代码”条目推送到VB堆栈上。
显然，只有在调用VBA方法时（原始的非VB Invoke调用NewEnum或我们自己的IDispatch_Invoke之后），才会发生此bug。如果调用非VB方法（如没有以下NewEnum的原始IDispatch::Invoke）时，该bug不会发生，如上面的Main3所示。如果在相同的情况下对VBA Collection使用For Each...，也不会发生bug。
bug的原因
如上面的所有示例所示，可以总结出以下bug的原因：
For Each调用IDispatch::Invoke，而IDispatch::Invoke又调用NewEnum，此时堆栈指针还没有增加ShowBug堆栈帧的大小。因此，相同的内存被ShowBug堆栈帧和NewEnum堆栈帧同时使用。
解决方法
强制正确增加堆栈指针的方法有：
1. 直接调用另一个方法（在For Each行之前），例如Sin 1。
2. 间接调用另一个方法（在For Each行之前）：
- 通过将参数传递为ByVal来调用IUnknown::AddRef。
- 通过使用stdole.IUnknown调用IUnknown::QueryInterface。
- 使用Set语句调用IUnknown::AddRef或IUnknown::Release或两者（例如Set c = c）。根据源接口和目标接口的不同，也可能调用IUnknown::QueryInterface。
正如问题中的“EDIT”部分所建议的，我们并不总是有可能将自定义集合类的参数传递为ByVal，因为它可能只是一个全局变量，或者是一个类成员，我们需要记住在执行For Each之前执行虚拟的Set语句或调用另一个方法。
解决方案
我仍然找不到比问题中提到的解决方法更好的解决方案，所以我只会在这里复制代码作为答案的一部分，稍微修改一下。
EnumHelper类：
（此处省略代码）
CustomCollection现在变成了这样：
（此处省略代码）
你只需要使用For Each v in c.NewEnum调用它。
尽管EnumHelper类将成为任何实现自定义集合类的项目中所需的额外类，但它也有一些优点：
1. 您永远不需要将Attribute [MethodName].VB_UserMemId = -4添加到任何其他自定义集合类中。这对于没有安装RubberDuck的用户来说，尤其有用（使用“'”注释符），因为他们需要为每个自定义集合类导出、编辑.cls文本文件并重新导入。
2. 您可以为同一个类公开多个EnumHelpers。考虑一个自定义字典类。您可以同时拥有ItemsEnum和KeysEnum。同时支持For Each v in c.ItemsEnum和For Each v in c.KeysEnum。
3. 在Invoke调用成员ID -4之前，您永远不会忘记使用上述任一解决方法，因为在调用之前会调用公开EnumHelper类的方法。
4. 您将不再遇到崩溃。如果您忘记使用For Each v in c.NewEnum，而是使用For Each v in c，您将只得到一个运行时错误，这在测试中会被检测到。当然，如果将c.NewEnum的结果传递给另一个方法ByRef，然后在任何其他方法调用或Set语句之前执行For Each，仍然可能会导致崩溃。但是，您几乎不太可能这样做。
5. 显而易见，您将在项目中使用相同的EnumHelper类来处理所有自定义集合类。
这篇文章深入地探讨了For Each枚举自定义类时出现的bug，包括问题的原因和解决方法。通过使用EnumHelper类作为解决方案，可以避免这个bug，并提供一些额外的优点。如果您在使用x64平台上的自定义类时遇到了类似的问题，希望这篇文章能对您有所帮助。
Bug with For Each enumeration on x64 Custom Classes（x64自定义类的ForEach枚举问题）
在这个讨论中，有用户提到了一个与之前讨论的问题非常相似的bug。该bug主要影响Windows 64位的64位Office版本。用户还提供了一些解决方法，其中一个是使用一个单独的EnumHelper类来避免这个bug。
用户还指出，该bug并不是Windows相关的问题，而是64位VBA特定的问题。用户在32位Windows上的32位Office上测试时并没有遇到这个问题。因此，可以得出结论这是一个与64位Office版本相关的问题。
此外，有用户提到他们尝试了使用Set语句和Sin机制来绕过这个bug，但在他们的项目中并没有起作用。然而，EnumHelper类的方法对他们有用。
总结起来，这个bug主要影响到了64位Office版本上的VBA编程。对于这个问题，可以尝试使用EnumHelper类来解决。