如何获取数组维度（数组参数传递错误）？

Question

我正在尝试通过 PeekArray 和 SafeArrayGetDim API 获取数组的维数，但是编译时出现“Type mismatch”。如果 Debug.Print SafeArrayGetDim(PeekArray(TestArray).Ptr) 可以正常工作。

请在下面找到 VB 代码。任何帮助将不胜感激。

Option Explicit

Private Type PeekArrayType
    Ptr As Long
    Reserved As Currency
End Type

Private Declare Function PeekArray Lib "kernel32" Alias "RtlMoveMemory" ( _
    Arr() As Any, Optional ByVal Length As Long = 4) As PeekArrayType

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByVal Ptr As Long) As Long


Sub GetArrayDimension()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    Debug.Print fnSafeArrayGetDim(TestArray)
End Sub


Function fnSafeArrayGetDim(varRunArray As Variant) As Long
    Dim varTmpArray() As Variant
    varTmpArray = varRunArray
    fnSafeArrayGetDim = SafeArrayGetDim(PeekArray(varTmpArray).Ptr)
End Function

Answer 1

改为

Function fnSafeArrayGetDim(ByRef varRunArray() As Long) As Long
    Dim varTmpArray() As Long
    varTmpArray = varRunArray
    fnSafeArrayGetDim = SafeArrayGetDim(PeekArray(varTmpArray).Ptr)
End Function

您不能将 Dim TestArray() As Long 放入 Dim varTmpArray() As Variant 中，您可以在此处尝试 varTmpArray = varRunArray。

如果你想更通用然后使用

Function fnSafeArrayGetDim(ByRef varRunArray As Variant) As Long
    Dim varTmpArray As Variant
    varTmpArray = varRunArray
    fnSafeArrayGetDim = SafeArrayGetDim(PeekArray(varTmpArray).Ptr)
End Function

例如：

您不能将 Long 数组放入 Variant 数组

Sub ThisDoesNotWork()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    
    Dim varTmpArray() As Variant 'with parenthesis
    varTmpArray = TestArray
End Sub

但您可以将 Long 数组放入 Variant（这不是数组）

Sub ThisWorks()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    
    Dim varTmpArray As Variant 'note this is without parenthesis!
    varTmpArray = TestArray
End Sub

你可以把一个Long数组放到另一个Long数组中

Sub ThisWorksToo()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    
    Dim varTmpArray() As Long 'with parenthesis it has to be the same type as TestArray
    varTmpArray = TestArray
End Sub

Answer 2

这是一个有效的 fnSafeArrayGetDim 函数

Option Explicit

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

Sub GetArrayDimension()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    Debug.Print fnSafeArrayGetDim(TestArray)
End Sub

Function fnSafeArrayGetDim(varRunArray As Variant) As Long
    Const VT_BYREF      As Long = &H4000
    Dim lVarType        As Long
    Dim lPtr            As Long
    
    Call CopyMemory(lVarType, varRunArray, 2)
    If (lVarType And vbArray) <> 0 Then
        Call CopyMemory(lPtr, ByVal VarPtr(varRunArray) + 8, 4)
        If (lVarType And VT_BYREF) <> 0 Then
            Call CopyMemory(lPtr, ByVal lPtr, 4)
        End If
        If lPtr <> 0 Then
            Call CopyMemory(fnSafeArrayGetDim, ByVal lPtr, 2)
        End If
    End If
End Function

您不需要 PeekArray，因为您处理的是纯 Variant 而不是 Variant()（Variant 的数组）、Long()（Longs 的数组）或 Byte()（Bytes 的数组）通常在 VB6 中以 () 结尾的类型在 COM 术语中称为 SAFEARRAY .

所以您的 varRunArray 是一个纯 Variant，指向位于 VarPtr(varRunArray) + 8 的 pparray 成员中的 SAFEARRAY。一旦你得到这个指针，你必须注意 Variant 的 vt 中的 VT_BYREF 标志，它引入了双重间接（你必须再次取消引用 lPtr = *lPtr）。此时如果你得到一个指向 SAFEARRAY 结构的非 NULL 指针，那么 cDim 成员在前 2 个字节中。

如何获取数组维度（数组参数传递错误）？

How to get Array Dimension(array parameter pass error)?

arrays

vb6