Как определить, инициализирован ли массив в VB6?

Question

Передача безразмерного массива в функцию Ubound VB6 вызовет ошибку, поэтому я хочу проверить, был ли он измерен, прежде чем пытаться проверить его верхнюю границу. Как мне это сделать?

Answer 1

Примечание: код был обновлен, оригинальную версию можно найти в истории изменений (не то, чтобы ее было полезно найти). Обновленный код не зависит от недокументированной функции GetMem4 и правильно обрабатывает массивы всех типов.

Примечание для пользователей VBA: Этот код предназначен для VB6, который никогда не получал обновление x64. Если вы намерены использовать этот код для 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 (обр) в этой точке? Это -1! Таким образом, передача этого массива в эту функцию IsArrayInitialized вернула бы значение true, но попытка получить доступ к arr (0) привела бы к ошибке индекса вне диапазона.

Answer 3

Вот что я сделал. Это похоже на ответ GSerg , но использует лучше документированную функцию API CopyMemory и полностью автономно (вы можете просто передать массив вместо ArrPtr (массив) этой функции). Он использует функцию VarPtr, которую Microsoft предупреждает против , но это приложение только для 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

Редактировать : Р.С. Конли указал в своем ответе , что (Not someArray) иногда будет возвращать 0, поэтому вы должны использовать ((Not someArray) = -1).

Answer 5

Оба метода GSerg и Raven являются недокументированными взломами, но поскольку Visual BASIC 6 больше не разрабатывается, это не проблема. Однако пример Raven работает не на всех машинах. Вы должны проверить, как это.

If (Not someArray) = -1, тогда

На некоторых машинах он возвращает ноль, на других какое-то большое отрицательное число.

Answer 6

В VB6 есть функция с именем «IsArray», но она не проверяет, был ли массив инициализирован. Вы получите ошибку 9 - нижний индекс вне диапазона, если вы попытаетесь использовать UBound для неинициализированного массива. Мой метод очень похож на 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

Это модификация ответа ворона . Без использования 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

Для любой переменной, объявленной как массив, вы можете легко проверить, инициализирован ли массив, вызвав API SafeArrayGetDim. Если массив инициализирован, то возвращаемое значение будет ненулевым, в противном случае функция вернет ноль.

Обратите внимание, что вы не можете использовать эту функцию с вариантами, которые содержат массивы. Это приведет к ошибке компиляции (несоответствие типов).

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