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），但我会考虑编译器错误：）

Answer 2

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

这就是我的用途。这类似于GSerg的answer，但使用了更好的文档CopyMemory API函数，并且完全是自包含的（您只需将数组而不是ArrPtr（数组）传递给此函数）。它确实使用了VarPtr函数，即Microsoft 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 4

我发现了这个：

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 5

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

If（Not someArray）= -1然后

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

Answer 6

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

这是对乌鸦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 8

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 9

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

处理此问题的最简单方法是确保在需要检查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 11

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

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

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

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

  String  id=marker.getTitle().substring(0,1);//if your places are < 10

Answer 12

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

Answer 13

由于想要在此处发表评论，因此会发布答案。

正确答案似乎来自@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运算符可以重载，这意味着一个类或当操作数的类型为时，结构可以重新定义其行为该类或结构。 Overloading

因此，Not会将数组解释为其按位表示，并且在数组为空或不一样时（以带符号的数字形式）区分输出。因此，可以认为这不是黑客，只是数组按位表示形式的文档，不是本文在这里公开和利用的。

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

由于提供了一种新方法，因此决定发布该方法，任何有权访问数组如何在其结构中表示的人都欢迎对其进行扩展，完善或调整。因此，如果有人提供证明，实际上不打算将其用于“不按位”处理，那么我们应该接受它不是hack，实际上是最好的干净答案，如果他们支持或不支持这种理论（如果是建设性的）欢迎对此发表评论。

Answer 14

API调用的唯一问题是从32位移动到64位操作系统这适用于Objects，Strings等......

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

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

Answer 16

  class ClientsController < ApplicationController
  before_action :set_client, only: [:show, :edit, :update, :destroy]

  # GET /clients
  # GET /clients.json
  def index
    @clients = Client.all
  end

  # GET /clients/1
  # GET /clients/1.json
  def show
    @workers = Worker.all
  end


  # views/clients/show.html.erb
  <ul>
   <% @workers.each do |worker| %>
    <li><%= worker.first_name %> <%= worker.client.business_name %></li>
   <% end %>
  </ul>

Answer 17

有两种略有不同的情景需要测试：

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

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。

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

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

此功能适用于以下四种情况，前面三个是我在外部dll COM创建Arr时找到的，第四个是Arr不是ReDim时 - ed（这个问题的主题）：

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

Answer 19

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

我在网上看到很多有关如何判断数组是否已初始化的建议。下面的函数将获取任何数组，检查该数组的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 21

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

If IsEmpty(a) Then
    Exit Function
End If

MSDN

Answer 22

Dim someArray() as Integer    

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

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

22 个答案: