对于变量数组,其中每个元素都是一个双数组,我可以执行以下操作:
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将指向内存中的相同块.(设置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
GSerg..
6
VB旨在隐藏复杂性.通常,这会产生非常简单直观的代码,有时却不会.
A 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中时会发生这种情况.
要获得适合于指针算术的实际展开数据指针,您需要查询SAFEARRAY*
指针Variant
,从中可以存储一个或两个间接级别的指针,并从那里获取数据指针.
在前面的示例的基础上,天真的非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
,和我可能会做,明天,但你的想法.
1> GSerg..:
VB旨在隐藏复杂性.通常,这会产生非常简单直观的代码,有时却不会.
A 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中时会发生这种情况.
要获得适合于指针算术的实际展开数据指针,您需要查询SAFEARRAY*
指针Variant
,从中可以存储一个或两个间接级别的指针,并从那里获取数据指针.
在前面的示例的基础上,天真的非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
,和我可能会做,明天,但你的想法.