Excel x64自定义类上每个枚举的错误

几个月前，我在VBA中发现了一个bug，无法找到一个合适的解决方法。这个bug真的很烦人，因为它限制了一个好的语言特性

使用自定义集合类时，通常需要一个枚举器，以便该类可以在

For Each

循环中使用。这可以通过添加以下行来完成：

Attribute [MethodName].VB_UserMemId = -4 'The reserved DISPID_NEWENUM

在功能/属性签名行之后，通过以下方式：

导出类模块，在文本编辑器中编辑内容，然后重新导入

在函数签名上方使用注释

'@Enumerator

，然后同步

不幸的是，在x64上，使用上述功能会导致写入错误的内存，并在某些情况下导致应用程序崩溃（稍后讨论）

复制错误

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

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

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

标准模块中的代码：

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

行停止，您可以在“局部变量”窗口中看到，局部变量的值突然发生了更改：

其中ptr1等于

ObjPtr（c）

。

NewEnum

方法中使用的变量越多（包括可选参数），

ShowBug

方法中使用值（内存地址）写入的PTR越多

不用说，删除

ShowBug

方法中的本地ptr变量肯定会导致应用程序崩溃

当逐行遍历代码时，此错误不会发生

---

有关该漏洞的更多信息

该错误与存储在

CustomCollection

中的实际

集合

无关。调用NewEnum函数后，内存会立即被写入。因此，基本上做以下任何一项都没有帮助（测试）：

添加

可选
参数

从函数中删除所有代码（请参见下面显示此代码的代码）

声明为

IUnknown

而不是

IEnumVariant

而不是

函数

声明为

属性Get

在方法签名中使用

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

方法）并返回。这需要在执行每个行的

之前发生（这意味着它可以在同一方法中的任何位置，而不一定是之前的确切行）：

缺点：容易忘记

执行

Set

语句。它可能位于循环中使用的变量上（如果没有使用其他对象）。如上文第1点所述，这需要在执行每行的

之前进行：

Set v = Nothing
For Each v In c
Next v

甚至可以使用
Set c=c

将集合设置为自身
或者，将c参数
ByVal
传递给
ShowBug
方法（该方法按设置调用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

显然，保留的DISPID已从

CustomCollection

类中删除

优点：在

.NewEnum

函数上强制对每个

执行
，而不是直接对自定义集合执行。这样可以避免由错误引起的任何崩溃

缺点：总是需要额外的
EnumHelper
类。很容易忘记为每一行添加
.NewEnum
（只会触发运行时错误）

最后一种方法（3）之所以有效，是因为当执行

c.NewEnum

时，将退出

ShowBug

方法，然后在

EnumHelper

类中调用

属性Get EnumVariant

之前返回该方法。基本上，方法（1）是避免错误的方法

---

这种行为的解释是什么？能否以更优雅的方式避免此错误

编辑

传递

CustomCollection

ByVal并不总是一个选项。考虑< <代码>类1>代码>：

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

显然，这个例子有点勉强，但是有一个“父”对象包含一个“子”对象的自定义集合是很常见的，而“父”可能想要执行一些涉及部分或全部“子”对象的操作

---

在这种情况下，很容易忘记在每一行的

之前执行
Set
语句或方法调用

虽然它们不应该重叠，但它们似乎是重叠的。在
ShowBug
方法中有足够的变量可以防止崩溃，并且变量的值（在调用方子例程中）只需更改，因为它们引用的内存也被另一个堆栈帧（被调用的子例程）使用，该堆栈帧后来添加/推送到调用堆栈的顶部

我们可以通过在问题的相同代码中添加两个
Debug.Print
语句来测试这一点

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

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

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

以及标准.bas模块中的调用代码：

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

通过运行
Main
我在即时窗口中得到类似的结果：


NewEnum
返回值的地址明显位于memor中
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

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