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

Question

向VB6的Ubound函数传递一个无维数组会导致一个错误，所以我想在检查它的上限之前检查它是否已经被标注了尺寸。我该怎么做呢？

Answer 1

这是我一起去的。这与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 2

我发现这一点：

Dim someArray() As Integer 

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

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

Answer 3

Dim someArray() as Integer  

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

Answer 4

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

我用这个：

Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long 
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long 

Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long 
    GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr) 
End Function 

Public Function UDTArrPtr(ByRef arr As Variant) As Long 
    If VarType(arr) Or vbArray Then 
    GetMem4 VarPtr(arr) + 8, VarPtr(UDTArrPtr) 
    Else 
    Err.Raise 5, , "Variant must contain array of user defined type" 
    End If 
End Function 


Public Function ArrayExists(ByVal ppArray As Long) As Long 
    GetMem4 ppArray, VarPtr(ArrayExists) 
End Function 

用法：

? ArrayExists(ArrPtr(someArray)) 

? ArrayExists(StrArrPtr(someArrayOfStrings)) 

? ArrayExists(UDTArrPtr(someArrayOfUDTs)) 

您的代码似乎做相同（SAFEARRAY测试**为NULL），但在其中，我会考虑一个编译器错误:)

Answer 6

这两种方法都通过一种方式GSerg和Raven是没有记录的黑客，但由于Visual BASIC 6不再被开发，所以它不是问题。然而Raven的例子并不适用于所有机器。你必须像这样测试。

如果（没有的someArray）= -1，那么

在一些机器将返回他人零一些大的负数。

Answer 7

我刚想到这个。很简单，不需要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函数的行为缺陷（其实我把它称为分割功能的缺陷）。以此为例：

Dim arr() As String 

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

此时Ubound（arr）的值是多少？这是-1！因此，将此数组传递给此IsArrayInitialized函数将返回true，但尝试访问arr（0）会导致下标超出范围错误。

Answer 8

当初始化数组时，将一个整数或布尔值与标志= 1并在需要时查询此标志。

Answer 9

这是修改了乌鸦的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 10

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

在VB6中有一个名为“IsArray的”功能，但如果阵列已初始化它不检查。如果您尝试在未初始化的阵列上使用UBound，您将收到错误9 - 下标超出范围。我的方法与SJ非常相似，只是它适用于所有变量类型并具有错误处理。如果选中了非数组变量，您将收到错误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 12

这工作对我来说，在这个任何错误？

If IsEmpty(a) Then 
    Exit Function 
End If 

MSDN

Answer 13

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 14

基于所有我在这个现有岗位这与一个类型数组启动作为交易时的工作最适合我读出的信息初始化。

它使测试代码与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 15

可以解决该问题与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 

对于我来说，每个元素+ 100毫秒初始化需要大约0.4 mksec，使用VB 6.0.9782进行编译，因此10M元素的阵列大约需要4.1秒。可以通过ScriptControl ActiveX实现相同的功能。

Answer 16

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 17

有两种略微不同的情况进行测试：

1. 阵列被初始化（有效它不是一个空指针）
2. 阵列被初始化并具有至少一个元件

例如Split(vbNullString, ",")这样的情况需要情况2，其返回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 18

处理最简单的方法是，以确保该数组的初始化前面，你需要检查的UBOUND之前。我需要一个在表单代码的（常规）区域中声明的数组。 即

Dim arySomeArray() As sometype 

然后在形式负载例程我REDIM阵列：

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 19

问题的标题问如何确定一个数组初始化，但是，看完后的问题，它看起来像真正的问题是如何让未初始化数组的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)
前