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

将一个未经维度的数组传递给VB6的Ubound函数将导致一个错误,所以我想在检查它的上限之前检查它是否已经被标注了尺寸。 我该怎么做呢?

我使用这个:

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)) 

你的代码似乎也是这样做的(testingSAFEARRAY **为NULL),但以某种方式,我会考虑一个编译器错误:)

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

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

我find了这个:

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

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

GSerg和Raven的这两种方法都是没有文档的,但是由于Visual BASIC 6不再被开发,所以它不是问题。 但是Raven的例子在所有机器上都不起作用。 你必须这样testing。

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

在某些机器上,它会返回一个零大的负数。

在VB6中有一个名为“IsArray”的函数,但是它不检查数组是否已经被初始化。 如果您尝试在未初始化的arrays上使用UBound,您将收到错误9 – 下标超出范围。 我的方法与SJ非常相似,除了它适用于所有variablestypes并具有error handling。 如果选中了非数组variables,则会收到错误13 – types不匹配。

 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 

这是乌鸦答案的修改。 没有使用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 ie 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. ie array not initialized End Function 

这个也应该在分裂function的情况下工作。 限制是你需要定义数组的types(在这个例子中是string)。

当你初始化数组时,把一个标志为1的整数或布尔值,并在需要时查询这个标志。

 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 

根据我在这篇文章中读到的所有信息,在处理一个以未初始化开始的types数组时,这对我来说是最好的。

它使testing代码与UBOUND的使用保持一致,并且不需要使用error handling来进行testing。

它依赖于零基数组(这是大多数开发中的情况)。

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

 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. 

处理这个最简单的方法是确保在你需要检查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 

我唯一的API调用问题是从32位操作系统转移到64位操作系统。
这适用于对象,string等…

 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 
 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 

你可以用Ubound()函数解决这个问题,通过使用JScript的VBArray()对象(与variablestypes,单VBArray()或multidimensional array一起工作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毫秒,使用VB 6.0.9782进行编译,所以10M元素的arrays大约需要4.1秒。 可以通过ScriptControl ActiveX来实现相同的function。

有两个稍微不同的scheme来testing:

  1. 该数组被初始化(实际上它不是一个空指针)
  2. 数组被初始化并且至less有一个元素

情况2是Split(vbNullString, ",")返回String数组, LBound=0UBound=-1 。 以下是我可以为每个testing生成的最简单的示例代码片段:

 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 

如果数组是string数组,则可以使用Join()方法作为testing:

 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 

这工作对我来说,在这个任何错误?

 If IsEmpty(a) Then Exit Function End If 

MSDN

 Dim someArray() as Integer If someArray Is Nothing Then Debug.print "this array is not initialised" End If