如何確定數組是否在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)
前