如何确定是否在VB6中初始化了一个数组？

Question

将未扩展的数组传递给VB6的Ubound函数将导致错误,因此我想在检查其上限之前检查它是否已被标注尺寸.我该怎么做呢？

Answer 1

我用这个:

Private Declare 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&

' When declared in this way, the passed array is wrapped in a Variant/ByRef. It is not copied.
' Returns *SAFEARRAY, not **SAFEARRAY
Public Function pArrPtr(ByRef arr As Variant) As Long
  'VarType lies to you, hiding important differences. Manual VarType here.
  Dim vt As Integer
  CopyMemory ByVal VarPtr(vt), ByVal VarPtr(arr), Len(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
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->pparray;
    CopyMemory ByVal VarPtr(pArrPtr), ByVal pArrPtr, Len(pArrPtr)          'pArrPtr = *pArrPtr;
  Else
    'Non-by-ref variant array. Contains *parray at offset 8
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->parray;
  End If
End Function

Public Function ArrayExists(ByRef arr As Variant) As Boolean
  ArrayExists = pArrPtr(arr) <> 0
End Function

用法:

? ArrayExists(someArray)

Private Declare 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&

' When declared in this way, the passed array is wrapped in a Variant/ByRef. It is not copied.
' Returns *SAFEARRAY, not **SAFEARRAY
Public Function pArrPtr(ByRef arr As Variant) As Long
  'VarType lies to you, hiding important differences. Manual VarType here.
  Dim vt As Integer
  CopyMemory ByVal VarPtr(vt), ByVal VarPtr(arr), Len(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
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->pparray;
    CopyMemory ByVal VarPtr(pArrPtr), ByVal pArrPtr, Len(pArrPtr)          'pArrPtr = *pArrPtr;
  Else
    'Non-by-ref variant array. Contains *parray at offset 8
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->parray;
  End If
End Function

Public Function ArrayExists(ByRef arr As Variant) As Boolean
  ArrayExists = pArrPtr(arr) <> 0
End Function

? ArrayExists(someArray)

你的代码似乎做同样的事情(测试SAFEARRAY**是NULL),但是在某种程度上我会考虑编译器bug :)

Answer 2

我只是想到了这个.很简单,不需要API调用.有什么问题吗？

Public Function IsArrayInitialized(arr) As Boolean

  Dim rv As Long

  On Error Resume Next

  rv = UBound(arr)
  IsArrayInitialized = (Err.Number = 0)

End Function

编辑:我确实发现了一个与Split函数行为相关的缺陷(实际上我称之为Split函数中的一个缺陷).举个例子:

Dim arr() As String

arr = Split(vbNullString, ",")
Debug.Print UBound(arr)

此时Ubound(arr)的价值是多少？它是-1!因此,将此数组传递给此IsArrayInitialized函数将返回true,但尝试访问arr(0)将导致下标超出范围错误.

Answer 3

这就是我的用途.这类似于GSerg的答案,但使用了更好的文档CopyMemory API函数,并且完全是自包含的(您只需将数组而不是ArrPtr(数组)传递给此函数).它确实使用了VarPtr函数,微软警告说,但这是一个仅限XP的应用程序,它可以工作,所以我不担心.

是的,我知道这个函数会接受你抛出的任何东西,但是我会把错误检查留给读者练习.

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Public Function ArrayIsInitialized(arr) As Boolean

  Dim memVal As Long

  CopyMemory memVal, ByVal VarPtr(arr) + 8, ByVal 4 'get pointer to array
  CopyMemory memVal, ByVal memVal, ByVal 4  'see if it points to an address...  
  ArrayIsInitialized = (memVal <> 0)        '...if it does, array is intialized

End Function

Answer 4

我找到了这个:

Dim someArray() As Integer

If ((Not someArray) = -1) Then
  Debug.Print "this array is NOT initialized"
End If

编辑:RS Conley在他的回答中指出(Not someArray)有时会返回0,所以你必须使用((不是someArray)= -1).

Answer 5

GSerg和Raven的两种方法都是无证件的黑客攻击,但由于Visual BASIC 6不再开发,因此它不是问题.但是Raven的例子并不适用于所有机器.你必须这样测试.

如果(不是someArray)= -1那么

在某些机器上,它会在其他机器上返回一个大的负数.

Answer 6

在VB6中有一个名为"IsArray"的函数,但它不检查数组是否已初始化.如果您尝试在未初始化的阵列上使用UBound,您将收到错误9 - 下标超出范围.我的方法与S J非常相似,除了它适用于所有变量类型并具有错误处理.如果选中非数组变量,您将收到错误13 - 类型不匹配.

Private Function IsArray(vTemp As Variant) As Boolean
    On Error GoTo ProcError
    Dim lTmp As Long

    lTmp = UBound(vTemp) ' Error would occur here

    IsArray = True: Exit Function
ProcError:
    'If error is something other than "Subscript
    'out of range", then display the error
    If Not Err.Number = 9 Then Err.Raise (Err.Number)
End Function