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

Question

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

Answer 1

注意：代码已经更新，原始版本可以在revision history中找到（不是找到它有用）。更新的代码不依赖于所有类型的未记录的GetMem4函数和correctly handles数组。

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），但是在某种程度上我会考虑编译器bug :)

Answer 2

基于我在这篇现有帖子中读到的所有信息，在处理以未初始化为开头的类型数组时，这对我来说是最好的。

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

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

不得使用“擦除”清除阵列。使用下面列出的替代品

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.

Answer 3

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

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

Answer 4

对于声明为数组的任何变量，您可以通过调用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

Answer 5

我唯一的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

Answer 6

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

Answer 7

您可以使用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毫秒初始化，使用VB 6.0.9782进行编译，因此10M元素阵列大约需要4.1秒。可以通过ScriptControl ActiveX实现相同的功能。

Answer 8

有两种略有不同的方案需要测试：

数组被初始化（实际上它不是空指针）
该数组已初始化并至少包含一个元素

案例2是像Split(vbNullString, ",")这样的案例，它返回String阵列与LBound=0和UBound=-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

Answer 9

问题的标题询问如何确定数组是否被初始化，但是，在阅读问题之后，看起来真正的问题是如何获得未初始化的数组的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和UBound2()的函数中均失败，因此错误处理可以完成工作
在Dim Arr() As Whatever之后，在ReDim Arr(X)之前

Answer 10

如果数组是字符串数组，则可以使用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

Answer 11

我在网上看到很多关于如何判断数组是否已经初始化的建议。下面是一个函数，它将接受任何数组，检查该数组的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

Answer 12

我只是想到了这个。很简单，不需要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 13

这对我有用，这有什么问题吗？

If IsEmpty(a) Then
    Exit Function
End If

MSDN

Answer 14

Dim someArray() as Integer    

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

Answer 15

这就是我的用途。这类似于GSerg的answer，但使用了更好的文档CopyMemory API函数，并且完全是自包含的（您可以将数组而不是ArrPtr（数组）传递给此函数）。它确实使用了Varptr函数，微软warns against，但这是一个仅限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 16

我找到了这个：

Dim someArray() As Integer

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

编辑：RS Conley在他的answer中指出（Not someArray）有时会返回0，所以你必须使用（（不是someArray）= -1）。

Answer 17

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

如果（不是someArray）= -1那么

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

Answer 18

在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

Answer 19

这是乌鸦的answer的修改。不使用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

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

Answer 20

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

Answer 21

初始化数组时，将整数或布尔值设置为flag = 1.并在需要时查询此标志。

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

问题描述投票：51回答：21

21个回答

最新问题

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

问题描述 投票：51回答：21

21个回答

最新问题

问题描述投票：51回答：21