ptr0

ptr0

关注
发信
关注(28)粉丝(399)

x64 自定义类上的 For Each 枚举错误

本文介绍了x64 自定义类上的 For Each 枚举错误的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

几个月前我在 VBA 中发现了一个错误，但找不到合适的解决方法.这个错误真的很烦人，因为它限制了一个很好的语言功能.

当使用自定义集合类时，通常需要一个枚举器，以便该类可以在 For Each 循环中使用.这可以通过添加以下行来完成:

Attribute [MethodName].VB_UserMemId = -4 '保留的DISPID_NEWENUM

紧接在函数/属性签名行之后:

  1. 导出类模块，在文本编辑器中编辑内容，然后重新导入
  2. 在函数签名上方使用
    其中 ptr1 等于 ObjPtr(c).NewEnum 方法中使用的变量越多(包括可选参数)，ShowBug 方法中的 ptr 就会被写入值(内存地址).

    不用说，删除 ShowBug 方法中的局部 ptr 变量肯定会导致应用程序崩溃.

    逐行单步执行代码时，不会出现这个bug！

    关于错误的更多信息

    该错误与存储在 CustomCollection 中的实际 Collection 无关.调用 NewEnum 函数后立即写入内存.因此，基本上执行以下任何操作都无济于事(已测试):

    1. 添加可选参数
    2. 从函数中删除所有代码(见下面的代码)
    3. 声明为 IUnknown 而不是 IEnumVariant
    4. 而不是 Function 声明为 Property Get
    5. 在方法签名中使用Friend或Static等关键字
    6. 将 DISPID_NEWENUM 添加到 Get 的 Let 或 Set 对应项，甚至隐藏前者(即，将 Let/Set 设为私有)).

    让我们尝试上面提到的第 2 步.如果 CustomCollection 变成:

    版本 1.0 类开始MultiUse = -1 '真结尾属性 VB_Name = CustomCollection"属性 VB_GlobalNameSpace = False属性 VB_Creatable = False属性 VB_PredeclaredId = False属性 VB_Exposed = False选项显式公共函数 NewEnum() 作为 IEnumVARIANT属性 NewEnum.VB_UserMemId = -4结束函数

    并将用于测试的代码改为:

    Sub Main()#如果 Win64 那么Dim c As New CustomCollection显示错误#别的MsgBox "32 位上不会出现此错误！", vbInformation, "Cancelled"#万一结束子子 ShowBug(c 作为 CustomCollection)Dim ptr0 As LongPtr将 ptr1 调暗为 LongPtrDim ptr2 As LongPtrDim ptr3 As LongPtrDim ptr4 As LongPtrDim ptr5 As LongPtrDim ptr6 As LongPtr将 ptr7 调暗为 LongPtr将 ptr8 调暗为 LongPtr将 ptr9 调暗为 LongPtr'Dim v As Variant'出错时继续下一步对于每个 v In c下一个出错时转到 0调试.断言 ptr0 = 0结束子

    运行 Main 会产生相同的错误.

    解决方法

    我发现的避免错误的可靠方法:

    1. 调用一个方法(基本上离开 ShowBug 方法)然后回来.这需要在 For Each 行执行之前发生(before 意味着它可以在同一方法中的任何地方，不一定是之前的确切行):

      Sin 0 '或 VBA.Int 1 - 你懂的对于每个 v In c下一个

      缺点:容易忘记

    2. 执行Set 语句.它可能在循环中使用的变体上(如果没有使用其他对象).正如上面的第 1 点，这需要在 For Each 行执行之前发生:

      设置 v = 无对于每个 v In c下一个

      或者甚至通过使用 Set c = c
      将集合设置为自身或者，将 c 参数 ByVal 传递给 ShowBug 方法(作为 Set，调用 IUnknown::AddRef)
      缺点:容易忘记

    3. 使用单独的 EnumHelper 类，它是唯一用于枚举的类:

      版本 1.0 类开始MultiUse = -1 '真结尾属性 VB_Name = EnumHelper"属性 VB_GlobalNameSpace = False属性 VB_Creatable = False属性 VB_PredeclaredId = False属性 VB_Exposed = False选项显式私有 m_enum 作为 IEnumVARIANT公共属性集 EnumVariant(newEnum_ As IEnumVARIANT)设置 m_enum = newEnum_最终财产公共属性 Get EnumVariant() As IEnumVARIANT属性 EnumVariant.VB_UserMemId = -4设置 EnumVariant = m_enum最终财产

      CustomCollection 将变成:

      版本 1.0 类开始MultiUse = -1 '真结尾属性 VB_Name = CustomCollection"属性 VB_GlobalNameSpace = False属性 VB_Creatable = False属性 VB_PredeclaredId = False属性 VB_Exposed = False选项显式私有 m_coll 作为集合私有子类_Initialize()设置 m_coll = 新集合结束子私有子类_Terminate()设置 m_coll = 无结束子公共子添加(v 作为变体)m_coll.Add v结束子公共函数 NewEnum() 作为 EnumHelperDim eHelper 作为新的 EnumHelper'设置 eHelper.EnumVariant = m_coll.[_NewEnum]设置 NewEnum = eHelper结束函数

      和调用代码:

      选项显式子主()#如果 Win64 那么Dim c As New CustomCollectionc.加1c.加2显示错误#别的MsgBox "32 位上不会出现此错误！", vbInformation, "Cancelled"#万一结束子子 ShowBug(c 作为 CustomCollection)Dim ptr0 As LongPtr将 ptr1 调暗为 LongPtrDim ptr2 As LongPtrDim ptr3 As LongPtrDim ptr4 As LongPtrDim ptr5 As LongPtrDim ptr6 As LongPtr将 ptr7 调暗为 LongPtr将 ptr8 调暗为 LongPtr将 ptr9 调暗为 LongPtr'Dim v As Variant'对于每个 v 在 c.NewEnum调试.打印 v下一个调试.断言 ptr0 = 0结束子

      显然，保留的 DISPID 已从 CustomCollection 类中删除.

      优点:在 .NewEnum 函数上强制 For Each 而不是直接自定义集合.这避免了由错误引起的任何崩溃.

      缺点:总是需要额外的 EnumHelper 类.很容易忘记在 For Each 行中添加 .NewEnum(只会触发运行时错误).

    最后一种方法 (3) 有效，因为当 c.NewEnum 被执行时，ShowBug 方法被退出，然后在调用 Property Get EnumVariant 之前返回 在 EnumHelper 类中.基本上方法(1)是避免错误的方法.

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

    编辑

    传递 CustomCollection ByVal 并不总是一个选项.考虑一个 Class1:

    选项显式私有 m_collection 作为 CustomCollection私有子类_Initialize()设置 m_collection = New CustomCollection结束子私有子类_Terminate()设置 m_collection = 无结束子公共子 AddElem(d As Double)m_collection.Add d结束子公共函数 SumElements() As DoubleDim v As VariantDim s As Double对于 m_collection 中的每个 vs = s + v下一个总和元素 = s结束函数

    现在是一个调用例程:

    Sub ForceBug()Dim c As Class1设置 c = 新类 1c.AddElem 2c.AddElem 5c.AddElem 7Debug.Print c.SumElements 'BOOM - 应用程序崩溃结束子

    显然，这个例子有点勉强，但有一个父母"是很常见的.包含子"的自定义集合的对象对象和父"可能想做一些涉及部分或全部孩子"的操作.

    在这种情况下，很容易忘记在 For Each 行之前执行 Set 语句或方法调用.

    解决方案

    发生了什么

    看起来

    NewEnum 返回值的地址显然位于 ShowBug 的 ptr0 和 ptr9 变量之间的内存地址 方法.所以，这就是变量从哪里获取值的原因，因为它们实际上来自 NewEnum 方法的堆栈帧(例如对象的 vtable 的地址或 IEnumVariant界面).如果变量不存在，那么崩溃很明显，因为内存的更关键部分被覆盖(例如 ShowBug 方法的帧指针地址).由于 NewEnum 方法的堆栈帧较大(例如，我们可以添加局部变量以增加大小)，因此调用堆栈中顶部堆栈帧和下方堆栈帧之间共享的内存越多.

    如果我们使用问题中描述的选项解决错误会发生什么?只需在 For Each v In c 行之前添加一个 Set v = Nothing，结果为:

    同时显示前一个值和当前值(蓝色边框)，我们可以看到 NewEnum 返回位于 ptr0 和 之外的内存地址ShowBug 方法的 ptr9 变量.似乎使用变通方法正确分配了堆栈帧.

    如果我们在 NewEnum 内部中断，调用堆栈看起来像这样:

    For Each 如何调用 NewEnum

    每个 VBA 类都派生自

    尽管由于 Invoke 方法的挂钩，代码从未到达 NewEnum 方法，但仍会出现相同的错误.堆栈帧再次被错误分配.

    同样，在 For Each v In c 之前添加一个 Set v = Nothing 结果为:

    堆栈帧分配正确(绿色边框).这表明问题不在于 NewEnum 方法，也不在于我们的替换 Invoke 方法.在调用我们的 Invoke 之前发生了一些事情.

    如果我们打破我们的IDispatch_Invoke，调用堆栈看起来像这样:

    最后一个例子.考虑一个空白(没有代码)类 Class1.如果我们在下面的代码中运行 Main3:

    选项显式子 Main3()#如果 Win64 那么Dim c As New Class1ShowBug3 c#别的MsgBox "32 位上不会出现此错误！", vbInformation, "Cancelled"#万一结束子Sub ShowBug3(ByRef c As Class1)Dim ptr0 As LongPtr将 ptr1 调暗为 LongPtrDim ptr2 As LongPtrDim ptr3 As LongPtrDim ptr4 As LongPtrDim ptr5 As LongPtrDim ptr6 As LongPtr将 ptr7 调暗为 LongPtr将 ptr8 调暗为 LongPtr将 ptr9 调暗为 LongPtr'Dim v As Variant'出错时继续下一步对于每个 v In c下一个调试.断言 ptr0 = 0结束子

    该错误根本不会发生.这与使用我们自己挂钩的 Invoke 运行 Main2 有何不同?在这两种情况下都返回 DISP_E_MEMBERNOTFOUND 并且没有调用 NewEnum 方法.

    好吧，如果我们并排查看之前显示的调用堆栈:

    我们可以看到非 VB Invoke 没有作为单独的非基本代码"被推送到 VB 堆栈上.入口.

    显然，该错误仅在调用 VBA 方法(通过原始非 VB Invoke 调用 NewEnum 或我们自己的 IDispatch_Invoke)时才会发生.如果调用非 VB 方法(如原始的 IDispatch::Invoke 没有跟随 NewEnum)，则不会像上面的 Main3 那样发生错误.在相同情况下在 VBA 集合上运行 For Each... 时也不会出现错误.

    错误原因

    正如上面所有的例子所表明的，这个错误可以总结如下:
    For Each 调用 IDispatch::Invoke 依次调用 NewEnum 而堆栈指针还没有随着 ShowBug 的大小增加 栈帧.因此，两个帧(调用方ShowBug 和被调用方NewEnum)使用相同的内存.

    解决方法

    强制正确递增堆栈指针的方法:

    1. 直接调用另一个方法(在 For Each 行之前)例如罪 1
    2. 间接调用另一个方法(在 For Each 行之前):
      • 通过传递参数ByVal
        • 调用IUnknown::AddRef
      • 使用stdole.IUnknown 接口调用IUnknown::QueryInterface
      • 使用 Set 语句，该语句将调用 AddRef 或 Release 或两者(例如 Set c = c).也可以根据源和目标接口调用 QueryInterface

    正如问题的 EDIT 部分所建议的，我们并不总是有可能传递自定义集合类 ByVal，因为它可能只是一个全局变量，或类成员，我们需要记住在执行 For Each... 之前执行一个虚拟的 Set 语句或调用另一个方法.

    解决方案

    我仍然找不到比问题中提出的更好的解决方案，所以我只是将代码复制到这里作为答案的一部分，并稍作调整.

    EnumHelper 类:

    版本 1.0 类开始MultiUse = -1 '真结尾属性 VB_Name = EnumHelper"属性 VB_GlobalNameSpace = False属性 VB_Creatable = False属性 VB_PredeclaredId = False属性 VB_Exposed = False选项显式私有 m_enum 作为 IEnumVARIANT公共属性集 EnumVariant(newEnum_ As IEnumVARIANT)设置 m_enum = newEnum_最终财产公共属性 Get EnumVariant() As IEnumVARIANT属性 EnumVariant.VB_UserMemId = -4设置 EnumVariant = m_enum最终财产公共属性 Get Self() 作为 EnumHelper设置自我=我最终财产

    CustomCollection 现在会变成这样:

    选项显式私有 m_coll 作为集合私有子类_Initialize()设置 m_coll = 新集合结束子私有子类_Terminate()设置 m_coll = 无结束子公共子添加(v 作为变体)m_coll.Add v结束子公共函数 NewEnum() 作为 EnumHelper使用新的 EnumHelper设置 .EnumVariant = m_coll.[_NewEnum]设置 NewEnum = .Self结束于结束函数

    你只需要调用 For Each v in c.NewEnum

    尽管 EnumHelper 类是任何实现自定义集合类的项目都需要的额外类，但它也有几个优点:

    1. 您永远不需要将 Attribute [MethodName].VB_UserMemId = -4 添加到任何其他自定义集合类.这对于没有安装 RubberDuck 的用户更有用('@Enumerator 注释)，因为他们需要导出、编辑 .cls 文本文件并为每个自定义集合类导入回
    2. 您可以为同一个类公开多个 EnumHelper.考虑一个自定义字典类.您可以同时拥有 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 来强制崩溃，然后该方法需要执行 For Each在任何其他方法调用或 Set 语句之前.你极不可能这样做
    5. 显而易见但值得一提的是，您可以为项目中可能拥有的所有自定义集合类使用相同的 EnumHelper 类

    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:

    1. Exporting the class module, editing the contents in a text editor, and then importing back
    2. 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):

    1. adding Optional parameters
    2. removing all code from within the function (see below code showing this)
    3. declaring as IUnknown instead of IEnumVariant
    4. instead of Function declaring as Property Get
    5. using keywords like Friend or Static in the method signature
    6. 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:

    1. Call a method (basically leave the ShowBug method) and come back. This needs to happen before the For 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

    2. 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 the For 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 parameter ByVal to the ShowBug method (which, as Set, does a call to IUnknown::AddRef)
      Cons: Easy to forget

    3. Using 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 the For 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.

    解决方案

    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 calledonly 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

    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:

    1. call another method directly (before the For Each line) e.g. Sin 1
    2. call another method indirectly (before the For Each line):
      • a call to IUnknown::AddRef by passing the argument ByVal
      • a call to IUnknown::QueryInterface by using the stdole.IUnknown interface
      • using a Set statement which will call either AddRef or Release or both (e.g. Set c = c). Could also call QueryInterface depending on the source and target interfaces

    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:

    1. 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
    2. You could expose multiple EnumHelpers for the same class. Consider a custom dictionary class. You could have an ItemsEnum and a KeysEnum at the same time. Both For Each v in c.ItemsEnum and For Each v in c.KeysEnum would work
    3. You would never forget to use one of the workarounds presented above as the method exposing the EnumHelper class would be called before Invoke is calling member ID -4
    4. You would not get crashes anymore. If you forget to call with For Each v in c.NewEnum and instead use For 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 of c.NewEnum to another method ByRef which would then need to execute a For Each before any other method call or Set statement. Highly unlikely you would ever do that
    5. Obvious but worth mentioning, you would use the same EnumHelper class for all the custom collection classes you might have in a project

    这篇关于x64 自定义类上的 For Each 枚举错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！

08-21 18:34
Powered by LMLPHP ©2024 ptr0 0.046287