arrays - 如何确定数组是否在 VB6 中初始化？

Question

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

score 24 · Accepted Answer

注意：代码已经更新，可以在修订历史中找到原始版本（不是说找到它有用）。更新后的代码不依赖于未记录的GetMem4函数并正确处理所有类型的数组。

VBA 用户注意事项：此代码适用于从未获得 x64 更新的 VB6。如果您打算将此代码用于 VBA，请参阅https://stackoverflow.com/a/32539884/11683了解 VBA 版本。您只需要获取CopyMemory声明和pArrPtr函数，剩下的就可以了。

我用这个：

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），但在某种程度上我认为是编译器错误 :)

score 22 · Accepted Answer

我刚想到这个。很简单，不需要 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) 会导致下标超出范围错误。

score 15 · Accepted Answer

这就是我一起去的。这类似于 GSerg 的answer，但使用了文档更好的 CopyMemory API 函数，并且是完全独立的（您可以只将数组而不是 ArrPtr(array) 传递给此函数）。它确实使用了微软警告不要使用的 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

score 14 · Accepted Answer

我找到了这个：

Dim someArray() As Integer

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

编辑：RS Conley 在他的回答中指出 (Not someArray) 有时会返回 0，因此您必须使用 ((Not someArray) = -1)。

score 9 · Accepted Answer

GSerg 和 Raven 的两种方法都是未记录的 hack，但由于 Visual BASIC 6 不再被开发，所以这不是问题。然而，Raven 的示例并不适用于所有机器。你必须像这样测试。

If (Not someArray) = -1 Then

在某些机器上，它会在其他一些较大的负数上返回零。

score 5 · Accepted Answer

在 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

score 4 · Accepted Answer

由于想要在这里发表评论将发布答案。

正确答案似乎来自@raven：

Dim someArray() As Integer

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

当文档或 Google 没有立即返回解释时，人们倾向于将其称为 hack。尽管似乎可以解释为Not不仅是逻辑运算符，而且还是位运算符，因此它处理结构的位表示，而不仅仅是布尔值。

例如，另一个按位运算在这里：

Dim x As Integer
x = 3 And 5 'x=1

所以上面的 And 也被视为按位运算符。

此外，值得检查，即使与此没有直接关系，

Not 运算符可以重载，这意味着当一个类或结构的操作数具有该类或结构的类型时，它可以重新定义其行为。重载

因此，Not 将数组解释为其按位表示，并且当数组为空或不同时以有符号数的形式区分输出。所以可以认为这不是黑客攻击，只是数组按位表示的文档，不是在这里暴露和利用的。

Not 采用单个操作数并反转所有位，包括符号位，并将该值分配给结果。这意味着对于有符号的正数，不总是返回负值，对于负数，不总是返回正值或零值。逻辑位

之所以决定发布，是因为这提供了一种新方法，欢迎任何有权访问数组在其结构中表示方式的人进行扩展、完成或调整。因此，如果有人提供证据，它实际上并不打算让数组被 Not bitwise 处理，我们应该接受它不是一个黑客，实际上是最好的干净答案，如果他们提供或不提供任何支持这个理论，如果它是建设性的当然，欢迎对此发表评论。

score 3 · Accepted Answer

这是对 raven答案的修改。不使用 API。

Public Function IsArrayInitalized(ByRef arr() As String) As Boolean
'Return True if array is initalized
On Error GoTo errHandler 'Raise error if directory doesnot exist

  Dim temp As Long
  temp = UBound(arr)

  'Reach this point only if arr is initalized i.e. no error occured
  If temp > -1 Then IsArrayInitalized = True 'UBound is greater then -1

Exit Function
errHandler:
  'if an error occurs, this function returns False. i.e. array not initialized
End Function

这个也应该在拆分功能的情况下工作。限制是您需要定义数组的类型（本例中为字符串）。

score 2 · Accepted Answer

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long

Private Type SafeArray
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
End Type

Private Function ArrayInitialized(ByVal arrayPointer As Long) As Boolean
    Dim pSafeArray As Long

    CopyMemory pSafeArray, ByVal arrayPointer, 4

    Dim tArrayDescriptor As SafeArray

    If pSafeArray Then
        CopyMemory tArrayDescriptor, ByVal pSafeArray, LenB(tArrayDescriptor)

        If tArrayDescriptor.cDims > 0 Then ArrayInitialized = True
    End If

End Function

用法：

Private Type tUDT
    t As Long
End Type

Private Sub Form_Load()
    Dim longArrayNotDimmed() As Long
    Dim longArrayDimmed(1) As Long

    Dim stringArrayNotDimmed() As String
    Dim stringArrayDimmed(1) As String

    Dim udtArrayNotDimmed() As tUDT
    Dim udtArrayDimmed(1) As tUDT

    Dim objArrayNotDimmed() As Collection
    Dim objArrayDimmed(1) As Collection


    Debug.Print "longArrayNotDimmed " & ArrayInitialized(ArrPtr(longArrayNotDimmed))
    Debug.Print "longArrayDimmed " & ArrayInitialized(ArrPtr(longArrayDimmed))

    Debug.Print "stringArrayNotDimmed " & ArrayInitialized(ArrPtr(stringArrayNotDimmed))
    Debug.Print "stringArrayDimmed " & ArrayInitialized(ArrPtr(stringArrayDimmed))

    Debug.Print "udtArrayNotDimmed " & ArrayInitialized(ArrPtr(udtArrayNotDimmed))
    Debug.Print "udtArrayDimmed " & ArrayInitialized(ArrPtr(udtArrayDimmed))

    Debug.Print "objArrayNotDimmed " & ArrayInitialized(ArrPtr(objArrayNotDimmed))
    Debug.Print "objArrayDimmed " & ArrayInitialized(ArrPtr(objArrayDimmed))

    Unload Me
End Sub

score 1 · Accepted Answer

当您初始化数组时，放置一个带有标志 = 1 的整数或布尔值。并在需要时查询此标志。

score 1 · Accepted Answer

根据我在这篇现有文章中阅读的所有信息，这在处理以未初始化形式开始的类型化数组时最适合我。

它使测试代码与 UBOUND 的使用保持一致，并且不需要使用错误处理来进行测试。

它依赖于基于零的数组（大多数开发都是这种情况）。

不得使用“Erase”清除阵列。使用下面列出的替代方案。

Dim data() as string ' creates the untestable holder.
data = Split(vbNullString, ",") ' causes array to return ubound(data) = -1
If Ubound(data)=-1 then ' has no contents
    ' do something
End If
redim preserve data(Ubound(data)+1) ' works to increase array size regardless of it being empty or not.

data = Split(vbNullString, ",") ' MUST use this to clear the array again.

score 1 · Accepted Answer

处理此问题的最简单方法是确保在需要检查 Ubound 之前预先初始化数组。我需要一个在表单代码的（常规）区域中声明的数组。IE

Dim arySomeArray() As sometype

然后在表单加载例程中，我重新调整了数组：

Private Sub Form_Load()

ReDim arySomeArray(1) As sometype 'insure that the array is initialized

End Sub

这将允许在程序稍后的任何时候重新定义数组。当您发现阵列需要多大时，只需重新调整它。

ReDim arySomeArray(i) As sometype 'i is the size needed to hold the new data

score 1 · Accepted Answer

对于任何声明为数组的变量，您可以通过调用 SafeArrayGetDim API 轻松检查数组是否已初始化。如果数组已初始化，则返回值将非零，否则函数返回零。

请注意，您不能将此函数用于包含数组的变体。这样做会导致编译错误（类型不匹配）。

Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (psa() As Any) As Long

Public Sub Main()
    Dim MyArray() As String

    Debug.Print SafeArrayGetDim(MyArray)    ' zero

    ReDim MyArray(64)
    Debug.Print SafeArrayGetDim(MyArray)    ' non-zero

    Erase MyArray
    Debug.Print SafeArrayGetDim(MyArray)    ' zero

    ReDim MyArray(31, 15, 63)
    Debug.Print SafeArrayGetDim(MyArray)    ' non-zero

    Erase MyArray
    Debug.Print SafeArrayGetDim(MyArray)    ' zero

    ReDim MyArray(127)
    Debug.Print SafeArrayGetDim(MyArray)    ' non-zero

    Dim vArray As Variant
    vArray = MyArray
    ' If you uncomment the next line, the program won't compile or run.
    'Debug.Print SafeArrayGetDim(vArray)     ' <- Type mismatch
End Sub

score 0 · Accepted Answer

如果数组是字符串数组，可以使用 Join() 方法作为测试：

Private Sub Test()

    Dim ArrayToTest() As String

    MsgBox StringArrayCheck(ArrayToTest)     ' returns "false"

    ReDim ArrayToTest(1 To 10)

    MsgBox StringArrayCheck(ArrayToTest)     ' returns "true"

    ReDim ArrayToTest(0 To 0)

    MsgBox StringArrayCheck(ArrayToTest)     ' returns "false"

End Sub


Function StringArrayCheck(o As Variant) As Boolean

    Dim x As String

    x = Join(o)

    StringArrayCheck = (Len(x) <> 0)

End Function

score 0 · Accepted Answer

我对 API 调用的唯一问题是从 32 位操作系统迁移到 64 位操作系统。
这适用于对象、字符串等...

Public Function ArrayIsInitialized(ByRef arr As Variant) As Boolean
    On Error Resume Next
    ArrayIsInitialized = False
    If UBound(arr) >= 0 Then If Err.Number = 0 Then ArrayIsInitialized = True
End Function

score 0 · Accepted Answer

您可以使用函数解决问题，Ubound()通过使用 JScript 的对象检索总元素计数来检查数组是否为空VBArray()（适用于变体类型的数组，单维或多维）：

Sub Test()

    Dim a() As Variant
    Dim b As Variant
    Dim c As Long

    ' Uninitialized array of variant
    ' MsgBox UBound(a) ' gives 'Subscript out of range' error
    MsgBox GetElementsCount(a) ' 0

    ' Variant containing an empty array
    b = Array()
    MsgBox GetElementsCount(b) ' 0

    ' Any other types, eg Long or not Variant type arrays
    MsgBox GetElementsCount(c) ' -1

End Sub

Function GetElementsCount(aSample) As Long

    Static oHtmlfile As Object ' instantiate once

    If oHtmlfile Is Nothing Then
        Set oHtmlfile = CreateObject("htmlfile")
        oHtmlfile.parentWindow.execScript ("function arrlength(arr) {try {return (new VBArray(arr)).toArray().length} catch(e) {return -1}}"), "jscript"
    End If
    GetElementsCount = oHtmlfile.parentWindow.arrlength(aSample)

End Function

对我来说，每个元素大约需要 0.4 mksec + 100 msec 初始化，使用 VB 6.0.9782 编译，因此 10M 个元素的数组大约需要 4.1 秒。相同的功能可以通过ScriptControlActiveX 实现。

score 0 · Accepted Answer

If ChkArray(MyArray)=True then
   ....
End If

Public Function ChkArray(ByRef b) As Boolean
    On Error goto 1
    If UBound(b) > 0 Then ChkArray = True
End Function

score 0 · Accepted Answer

有两种稍微不同的场景需要测试：

数组已初始化（实际上它不是空指针）
数组已初始化且至少有一个元素

情况 2 是必需的，例如Split(vbNullString, ",")返回带有and的String数组。以下是我可以为每个测试生成的最简单的示例代码片段：LBound=0UBound=-1

Public Function IsInitialised(arr() As String) As Boolean
  On Error Resume Next
  IsInitialised = UBound(arr) <> 0.5
End Function

Public Function IsInitialisedAndHasElements(arr() As String) As Boolean
  On Error Resume Next
  IsInitialisedAndHasElements = UBound(arr) >= LBound(arr)
End Function

score 0 · Accepted Answer

问题的标题询问如何确定数组是否已初始化，但是，在阅读了问题之后，看起来真正的问题是如何获取UBound未初始化的数组。

这是我的解决方案（针对实际问题，而不是标题）：

Function UBound2(Arr) As Integer
  On Error Resume Next
  UBound2 = UBound(Arr)
  If Err.Number = 9 Then UBound2 = -1
  On Error GoTo 0
End Function

此函数在以下四种情况下工作，我发现前三种Arr是由外部 dll COM 创建的，第四种Arr是在未ReDim-ed 时发现的（这个问题的主题）：

UBound(Arr)有效，因此调用UBound2(Arr)会增加一些开销，但不会造成太大伤害
UBound(Arr)在定义的函数中失败Arr，但在内部成功UBound2()
UBound(Arr)在定义Arr和 in的函数中都失败了UBound2()，因此错误处理完成了工作
之后Dim Arr() As Whatever,之前ReDim Arr(X)

score -1 · Accepted Answer

我在网上看到很多关于如何判断数组是否已初始化的建议。下面是一个函数，它将采用任何数组，检查该数组的 ubound 是什么，将数组重新调整为 ubound +1（有或没有 PRESERVER），然后返回数组的当前 ubound 是什么，没有错误。

Function ifuncRedimUbound(ByRef byrefArr, Optional bPreserve As Boolean)
On Error GoTo err:

1: Dim upp%:           upp% = (UBound(byrefArr) + 1)

errContinue:

If bPreserve Then
         ReDim Preserve byrefArr(upp%)
Else
         ReDim byrefArr(upp%)
End If

ifuncRedimUbound = upp%


Exit Function
err:
If err.Number = 0 Then Resume Next
    If err.Number = 9 Then ' subscript out of range (array has not been initialized yet)
             If Erl = 1 Then
                         upp% = 0
                         GoTo errContinue:
             End If
    Else
               ErrHandler.ReportError "modArray", ifuncRedimUbound, "1", err.Number, err.Description
    End If
End Function

score -2 · Accepted Answer

-2

这对我有用，这有什么错误吗？

If IsEmpty(a) Then
    Exit Function
End If

MSDN

于 2014-06-25T06:52:15.883 回答

score -8 · Accepted Answer

Dim someArray() as Integer    

If someArray Is Nothing Then
    Debug.print "this array is not initialised"
End If

arrays - 如何确定数组是否在 VB6 中初始化？

22 回答 22

Related

Reference