对于每个元素都是 double 组的变体数组,我可以执行以下操作:
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 和 B 将指向内存中的同一个 block 。 (设置 W = vntArr(1) 创建一个副本。对于非常大的数组,我想避免这种情况。)
我正在尝试做同样的事情,但是对于集合:
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
这种方法可行,但由于某种原因,col("A") 返回的安全数组结构(包装在 Variant 数据类型中,类似于上面的变体数组)仅包含一些外部属性,例如维度数和暗淡边界,但是指向 pvData 的指针它本身是空的,因此 CopyMemoryArray 调用会导致崩溃。 (设置 B = col("A") 效果很好。)与 Scripting.Dictionary 的情况相同。
<小时/>编辑
#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 旨在隐藏复杂性。通常这会产生非常简单和直观的代码,有时却不会。
VARIANT
可以包含非 VARIANT
数据的数组,没有问题,例如正确的 Double
数组。但是,当您尝试从 VB 访问此数组时,您不会得到原始的 Double
,就像它实际存储的是 blob 一样,而是将其包装在临时的 Variant
中,在访问时构造,专门是为了让您不会对声明为 As Variant
的数组突然生成一个值 As Double
感到惊讶。您可以在此示例中看到:
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
在我的电脑上结果是:
88202488 1635820
88204104 1635820
88205720 1635820
来自 A
的元素实际上是不同的,并且位于内存中它们应该在数组中的位置,并且每个元素的大小为 8 个字节,而 A_wrapper
的“元素”实际上是相同的“元素” - 重复三次的数字是临时 Variant
的地址,大小为 16 字节,创建它是为了保存数组元素,编译器决定重用它。
这就是为什么以这种方式返回的数组元素不能用于指针运算。
集合本身不会给这个问题带来任何影响。事实上,Collection 必须将其存储的数据包装在 Variant
中,这让情况变得困惑。当将数组存储在任何其他位置的 Variant 中时也会发生这种情况。
要获取适合指针算术的实际未包装数据指针,您需要从 Variant
中查询 SAFEARRAY*
指针,其中可以存储一到两个间接级别,并从那里获取数据指针。
构建于 previous examples ,简单的非 x64 兼容代码是:
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
然后可以通过以下非 x64 兼容方式使用:
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
请注意,我不确定 c("A")
每次都会返回相同的实际数据,而不是随意复制,因此可能不建议以这种方式缓存指针,您最好先将 c("A")
的结果保存到变量中,然后调用 GetPointerToData
。
显然,这应该重写为使用 LongPtr
和 CopyMemory
,我明天可能会这样做,但你明白了。
关于vba - 指向存储为集合/字典项的数组的指针 VBA,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/43552182/