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

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

ОТВЕТЫ

Ответ 1

Вот с чем я пошел. Это похоже на GSerg answer, но использует лучшую документально подтвержденную функцию 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

Ответ 2

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

Примечание для пользователей VBA: Этот код предназначен для VB6, который никогда не получал обновление x64. Если вы намереваетесь использовать этот код для VBA, см. fooobar.com/questions/93315/... для версии 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), но таким способом, который я бы посчитал ошибкой компилятора :)

Ответ 3

Я только подумал об этом. Достаточно просто, никаких вызовов 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) приведет к ошибке индекса за пределами диапазона.

Ответ 4

Я нашел это:

Dim someArray() As Integer

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

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

Ответ 5

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

If (Not someArray) = -1 Затем

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

Ответ 6

В VB6 есть функция, называемая "IsArray", но она не проверяет, был ли массив инициализирован. Вы получите Error 9 - Subscript вне диапазона, если вы попытаетесь использовать 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

Ответ 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

Этот должен также работать в случае функции split. Ограничение - вам нужно определить тип массива (строка в этом примере).

Ответ 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

Ответ 9

Когда вы инициализируете массив, поместите целое или логическое значение с флагом = 1. и запросите этот флаг, когда вам нужно.

Ответ 10

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

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

Ответ 11

Самый простой способ справиться с этим заключается в том, чтобы убедиться, что массив инициализирован спереди, прежде чем вам нужно будет проверить Ubound. Мне нужен массив, который был объявлен в области (General) кода формы. то есть.

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

Ответ 12

Для любой переменной, объявленной как массив, вы можете легко проверить, инициализирован ли массив, вызвав 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

Ответ 13

Моя единственная проблема с вызовами 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

Ответ 14

Вы можете решить проблему с помощью функции 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 мксека для каждого элемента + 100 мс инициализация, скомпилированная с VB 6.0.9782, поэтому массив из 10 М элементов занимает около 4,1 сек. Такую же функциональность можно реализовать с помощью ScriptControl ActiveX.

Ответ 15

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

Ответ 16

Есть два разных сценария:

  • Массив инициализируется (фактически это не нулевой указатель)
  • Массив инициализирован и имеет по крайней мере один элемент

Случай 2 необходим для таких случаев, как Split(vbNullString, ","), который возвращает массив 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

Ответ 17

В заголовке вопроса спрашивается, как определить, инициализирован ли массив, но после прочтения вопроса похоже, что реальная проблема заключается в том, как получить 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 создается внешним COM dll, и четвертый, когда Arr не является ReDim -ed (предмет этого вопроса):

  • UBound(Arr) работает, поэтому вызов UBound2(Arr) добавляет немного накладных расходов, но не сильно мешает
  • UBound(Arr) терпит неудачу в функции, которая определяет Arr, но преуспевает внутри UBound2()
  • UBound(Arr) как в функции, которая определяет Arr и в UBound2(), поэтому обработка ошибок выполняет свою работу
  • После Dim Arr() As Whatever и прежде, до ReDim Arr(X)

Ответ 18

Так как хотел комментировать, здесь будет размещен ответ.

Правильный ответ кажется от @raven:

Dim someArray() As Integer

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

Когда документация или Google не сразу возвращают объяснение, люди склонны называть это хаком. Хотя объяснение выглядит так: Not - это не только логический, но и побитовый оператор, поэтому он обрабатывает битовое представление структур, а не только логические значения.

Например, другая побитовая операция здесь:

Dim x As Integer
x = 3 And 5 'x=1

Таким образом, вышеприведенный А также рассматривается как побитовый оператор.

Кроме того, и стоит проверить, даже если это не имеет прямого отношения к этому,

Оператор Not может быть перегружен, что означает, что класс или структура может переопределить свое поведение, когда ее операнд имеет тип этот класс или структура. Перегрузки

Соответственно, Not интерпретирует массив как его побитовое представление и различает выходные данные, когда массив пуст или не похож на другой, в виде числа со знаком. Таким образом, можно считать, что это не хак, а просто недокументирование побитового представления массива, которое не здесь раскрывает и использует в своих интересах.

Не принимает один операнд и инвертирует все биты, включая знаковый бит и присваивает это значение результату. Это означает, что для положительные числа со знаком, не всегда возвращает отрицательное значение, а для отрицательные числа, не всегда возвращает положительное или нулевое значение. Логический побитовый

Приняв решение опубликовать с тех пор, как это предложило новый подход, который может быть расширен, дополнен или скорректирован любым, кто имеет доступ к тому, как массивы представляются в их структуре. Поэтому, если кто-либо предлагает доказательство того, что оно фактически не предназначено для обработки массивов с помощью Not bitwise, мы должны принять его как не хак, а на самом деле как лучший чистый ответ, если они делают или не предлагают никакой поддержки этой теории, если она конструктивна комментировать это приветствуется, конечно.

Ответ 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

Ответ 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

Ответ 21

Это сработало для меня, любая ошибка в этом?

If IsEmpty(a) Then
    Exit Function
End If

MSDN

Ответ 22

Dim someArray() as Integer    

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