指向存储为集合/字典项VBA的数组的指针 [英] Pointers to arrays stored as collection/dictionary items VBA

查看：98
本文介绍了指向存储为集合/字典项VBA的数组的指针的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

对于每个元素都是双精度数组的变量数组，我可以执行以下操作:

 公共声明PtrSafe子CopyMemoryArray库"kernel32"别名"RtlMoveMemory"(ByRef Destination()为任意，ByRef源为任意，ByVal长度为长)子测试()Dim vntArr()作为变体昏暗的A()为双Dim B()为DoubleRedim vntArr(1至10)Redim A(1至100、1至200)vntArr(1)= ACopyMemoryArray B，ByVal VarPtr(vntArr(1))+ 8，PTR_LENGTH'4或8'做一点事ZeroMemoryArray B，PTR_LENGTH结束子

A和B然后将指向内存中的同一块.(设置W = vntArr(1)会创建一个副本.对于非常大的数组，我想避免这种情况.)

我正在尝试做同样的事情，但是要使用收藏集:

  Sub test()Dim col作为收藏Dim A()为DoubleDim B()为Double设置col =新收藏列.添加A，"A"CopyMemoryArray B，ByVal VarPtr(col("A"))+ 8，PTR_LENGTH'4或8'做一点事ZeroMemoryArray B，PTR_LENGTH结束子

这种工作方式，但是出于某种原因，由col("A")返回的安全数组结构(包装为Variant数据类型，类似于上面的variant数组)仅包含一些外部属性，例如维数和暗边界，但指向

编辑

  #If Win64然后只要保持公共公共PTR_LENGTH = 8#别的公共常量PTR_LENGTH只要= 4#万一公共声明PtrSafe子CopyMemory库"kernel32"别名"RtlMoveMemory"(ByRef目标为任何，ByRef源为任何，ByVal长度为长)私有常量VT_BYREF只要Long =& H4000&私有常量S_OK只要Long =& H0&私有函数pArrPtr(作为变体的ByRef arr)作为LongPtrDim vt As IntegerCopyMemory vt，arr，2如果(vt和vbArray)<>vbArray然后Err.Raise 5，变量必须包含数组"万一如果(vt和VT_BYREF)= VT_BYREF则CopyMemory pArrPtr，ByVal VarPtr(arr)+ 8，PTR_LENGTHCopyMemory pArrPtr，ByVal pArrPtr，PTR_LENGTH别的CopyMemory pArrPtr，ByVal VarPtr(arr)+ 8，PTR_LENGTH万一结束功能私有函数GetPointerToData(作为变体的ByRef arr)作为LongPtr昏暗的pvDataOffset尽可能长#If Win64然后pvDataOffset = 64位计算机上的16'4额外未使用字节#别的pvDataOffset = 12#万一CopyMemory GetPointerToData，ByVal pArrPtr(arr)+ pvDataOffset，PTR_LENGTH结束功能子CollectionWorks()昏暗A(1至100，1至50)两倍A(3，1)= 42点心收藏设置c =新收藏c.添加A，"A"Dim ActualPointer作为LongPtrActualPointer = GetPointerToData(c("A"))昏暗双CopyMemory r，ByVal ActualPointer +(0 + 2)* 8，8MsgBox r'显示42结束子

解决方案

VB旨在隐藏复杂性.通常，这会导致非常简单直观的代码，有时却不会.

一个 VARIANT 可以包含一个非 VARIANT 数据数组，没问题，例如一个正确的 Double 数组.但是，当您尝试从VB访问此数组时，不会得到原始的 Double ，就像它实际存储的是blob一样，而是将其包装在临时的 Variant 中，是在访问时构造的，尤其是不要让声明为 As Variant 的数组突然产生值 As Double 的事实感到惊讶.在此示例中，您可以看到:

  Sub NoRawDoubles()昏暗A(1至100，1至50)为两倍变暗的A_wrapper变体A_wrapper = A调试.打印VarPtr(A(1，1))，VarPtr(A_wrapper(1，1))调试.打印VarPtr(A(3，3))，VarPtr(A_wrapper(3，3))调试.打印VarPtr(A(5，5))，VarPtr(A_wrapper(5，5))结束子

在我的计算机上，结果是:

 <代码> 88202488 163582088204104 163582088205720 1635820

实际上， A 中的

个元素不同，它们位于内存中应位于数组中的位置，每个元素的大小为8个字节，而 A_wrapper 中的元素"实际上是相同的元素"-该数字重复3次是临时 Variant 的地址，其大小为16个字节，该地址是为了保存数组元素而创建的，编译器决定重用该地址.

这就是为什么不能将以这种方式返回的数组元素用于指针算术.

集合本身不会给此问题添加任何内容.实际上，Collection必须将其存储的数据包装在 Variant 中，从而弄乱了数据.将数组存储在Variant中的任何其他位置时也会发生这种情况.

要获取适用于指针算术的实际展开数据指针，您需要从 Variant 中查询 SAFEARRAY * 指针，该指针可以存储一两个级别的间接操作，然后从那里获取数据指针.

以以前的示例为基础，原始的非x64兼容代码为:

 私有声明函数GetMem2 Lib"msvbvm60"(ByVal pSrc为长，ByVal pDst为长)私有声明函数GetMem4 Lib"msvbvm60"(ByVal pSrc长，ByVal pDst长)'如果感觉不好，请用CopyMemory替换私有常量VT_BYREF只要Long =& H4000&私有函数pArrPtr(由ByRef arr作为变体)只要'警告':返回* SAFEARRAY，而不是* SAFEARRAY'VarType对您说谎，隐藏了重要的差异.此处为手动VarType.Dim vt As IntegerGetMem2 ByVal VarPtr(arr)，ByVal VarPtr(vt)如果(vt和vbArray)<>vbArray然后Err.Raise 5，变量必须包含数组"万一'请参阅https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627%28v=vs.85%29.aspx如果(vt和VT_BYREF)= VT_BYREF则'由引用变体数组组成.在偏移量8处包含** pparrayGetMem4 ByVal VarPtr(arr)+ 8，ByVal VarPtr(pArrPtr)'pArrPtr = arr-> pparray;GetMem4 ByVal pArrPtr，ByVal VarPtr(pArrPtr)'pArrPtr = * pArrPtr;别的'Non-by-ref变量数组.在偏移量8处包含* parrayGetMem4 ByVal VarPtr(arr)+ 8，ByVal VarPtr(pArrPtr)'pArrPtr = arr-> parray;万一结束功能私有函数GetPointerToData(ByRef arr As Variant)只要很长GetMem4 pArrPtr(arr)+ 12，VarPtr(GetPointerToData)结束功能

然后可以通过以下非x64兼容方式使用它:

  Sub CollectionWorks()昏暗A(1至100，1至50)为两倍A(3，1)= 42点心收藏设置c =新收藏c.添加A，"A"昏暗的ActualPointer一样长ActualPointer = GetPointerToData(c("A"))昏暗双GetMem4 ActualPointer +(0 + 2)* 8，VarPtr(r)GetMem4 ActualPointer +(0 + 2)* 8 + 4，VarPtr(r)+ 4MsgBox r'显示42结束子

请注意，我不确定 c("A")每次都会返回相同的实际数据，而不是根据需要进行复制，因此不建议以这种方式缓存指针，最好先将 c("A")的结果保存到变量中，然后再调用 GetPointerToData .

显然，应该使用 LongPtr 和 CopyMemory 重写此代码，我明天可能会这样做，但是您明白了.

With variant arrays where each element is a double array I am able to do the following:

Public Declare PtrSafe Sub CopyMemoryArray Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination() As Any, ByRef Source As Any, ByVal Length As Long)

Sub test()
    Dim vntArr() as Variant
    Dim A() as Double
    Dim B() as Double

    Redim vntArr(1 to 10)
    Redim A(1 to 100, 1 to 200)
    vntArr(1) = A
    CopyMemoryArray B, ByVal VarPtr(vntArr(1)) + 8, PTR_LENGTH '4 or 8
    'Do something
    ZeroMemoryArray B, PTR_LENGTH
End Sub

A and B will then point to the same block in memory. (Setting W = vntArr(1) creates a copy. With very large arrays, I want to avoid this.)

I'm trying to do the same, but with collections:

Sub test()
    Dim col as Collection
    Dim A() as Double
    Dim B() as Double

    Set col = New Collection
    col.Add A, "A"
    CopyMemoryArray B, ByVal VarPtr(col("A")) + 8, PTR_LENGTH '4 or 8
    'Do something
    ZeroMemoryArray B, PTR_LENGTH
End Sub

This sort of works, but for some reason the safe array structure (wrapped in Variant data type, similar to the variant array above) returned by col("A") only contains some exterior attributes like number of dimensions and dim boundaries, but the pointer to the pvData itself is empty, and so CopyMemoryArray call results in a crash. (Setting B = col("A") works fine.) Same situation with Scripting.Dictionary.

Does anyone know what's going on here?

EDIT

#If Win64 Then
    Public Const PTR_LENGTH As Long = 8
#Else
    Public Const PTR_LENGTH As Long = 4
#End If

Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const VT_BYREF As Long = &H4000&
Private Const S_OK As Long = &H0&

Private Function pArrPtr(ByRef arr As Variant) As LongPtr
    Dim vt As Integer

    CopyMemory vt, arr, 2
    If (vt And vbArray) <> vbArray Then
        Err.Raise 5, , "Variant must contain an array"
    End If
    If (vt And VT_BYREF) = VT_BYREF Then
        CopyMemory pArrPtr, ByVal VarPtr(arr) + 8, PTR_LENGTH
        CopyMemory pArrPtr, ByVal pArrPtr, PTR_LENGTH
    Else
        CopyMemory pArrPtr, ByVal VarPtr(arr) + 8, PTR_LENGTH
    End If
End Function

Private Function GetPointerToData(ByRef arr As Variant) As LongPtr
    Dim pvDataOffset As Long
    #If Win64 Then
        pvDataOffset = 16 '4 extra unused bytes on 64bit machines
    #Else
        pvDataOffset = 12
    #End If
    CopyMemory GetPointerToData, ByVal pArrPtr(arr) + pvDataOffset, PTR_LENGTH
End Function

Sub CollectionWorks()
    Dim A(1 To 100, 1 To 50) As Double

    A(3, 1) = 42

    Dim c As Collection
    Set c = New Collection

    c.Add A, "A"

    Dim ActualPointer As LongPtr
    ActualPointer = GetPointerToData(c("A"))

    Dim r As Double
    CopyMemory r, ByVal ActualPointer + (0 + 2) * 8, 8

    MsgBox r  'Displays 42
End Sub

解决方案

VB is designed to hide complexity. Often that results in very simple and intuitive code, sometimes it does not.

A VARIANT can contain an array of non-VARIANT data no problem, such as an array of proper Doubles. But when you try to access this array from VB, you don't get a raw Double like it is actually stored is the blob, you get it wrapped in a temporary Variant, constructed at the time of access, specifically to not surprise you with the fact that an array declared As Variant suddenly produces a value As Double. You can see that in this example:

Sub NoRawDoubles()
  Dim A(1 To 100, 1 To 50) As Double
  Dim A_wrapper As Variant

  A_wrapper = A

  Debug.Print VarPtr(A(1, 1)), VarPtr(A_wrapper(1, 1))
  Debug.Print VarPtr(A(3, 3)), VarPtr(A_wrapper(3, 3))
  Debug.Print VarPtr(A(5, 5)), VarPtr(A_wrapper(5, 5))
End Sub

On my computer the result is:

88202488      1635820 
88204104      1635820 
88205720      1635820

Elements from A are in fact different and are located in memory where they should within the array and each one is 8 bytes in size, whereas "elements" of A_wrapper are in fact the same "element" - that number repeated three times is the address of the temporary Variant, 16 bytes in size, that is created to hold the array element and which the compiler decided to reuse.

That is why an array element returned in this way cannot be used for pointer arithmetic.

Collections themselves do not add anything to this problem. It's the fact that Collection has to wrap the data it stores in a Variant that messes it up. It would happen when storing an array in a Variant in any other place too.

To get the actual unwrapped data pointer suitable for pointer arithmetic, you need to query the SAFEARRAY* pointer from the Variant, where it can be stored with one or two levels of indirection, and take the data pointer from there.

Building on previous examples, the naive non-x64-compatible code for that would be:

Private Declare Function GetMem2 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long  ' Replace with CopyMemory if feel bad about it
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long  ' Replace with CopyMemory if feel bad about it

Private Const VT_BYREF As Long = &H4000&

Private Function pArrPtr(ByRef arr As Variant) As Long  'Warning: returns *SAFEARRAY, not **SAFEARRAY
  'VarType lies to you, hiding important differences. Manual VarType here.
  Dim vt As Integer
  GetMem2 ByVal VarPtr(arr), ByVal VarPtr(vt)

  If (vt And vbArray) <> vbArray Then
    Err.Raise 5, , "Variant must contain an array"
  End If


  'see https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627%28v=vs.85%29.aspx
  If (vt And VT_BYREF) = VT_BYREF Then
    'By-ref variant array. Contains **pparray at offset 8
    GetMem4 ByVal VarPtr(arr) + 8, ByVal VarPtr(pArrPtr)  'pArrPtr = arr->pparray;
    GetMem4 ByVal pArrPtr, ByVal VarPtr(pArrPtr)          'pArrPtr = *pArrPtr;
  Else
    'Non-by-ref variant array. Contains *parray at offset 8
    GetMem4 ByVal VarPtr(arr) + 8, ByVal VarPtr(pArrPtr)  'pArrPtr = arr->parray;
  End If

End Function

Private Function GetPointerToData(ByRef arr As Variant) As Long
  GetMem4 pArrPtr(arr) + 12, VarPtr(GetPointerToData)
End Function

Which then can be used in the following non-x64-compatible way:

Sub CollectionWorks()
  Dim A(1 To 100, 1 To 50) As Double

  A(3, 1) = 42

  Dim c As Collection
  Set c = New Collection

  c.Add A, "A"

  Dim ActualPointer As Long
  ActualPointer = GetPointerToData(c("A"))

  Dim r As Double
  GetMem4 ActualPointer + (0 + 2) * 8, VarPtr(r)
  GetMem4 ActualPointer + (0 + 2) * 8 + 4, VarPtr(r) + 4

  MsgBox r  'Displays 42
End Sub

Note that I am not sure that c("A") returns the same actual data every time as opposed to making copies as it pleases, so caching the pointer in this way may not be advised, and you might be better off first saving the result of c("A") into a variable and then calling GetPointerToData off that.

Obviously this should be rewritten to use LongPtr and CopyMemory, and I might do that tomorrow, but you get the idea.

这篇关于指向存储为集合/字典项VBA的数组的指针的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆