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

arrays vb6

42270 просмотра

21 ответа

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

Автор: raven Источник Размещён: 17.05.2019 03:18

Ответы (21)


22 плюса

Я использую это:

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), но таким образом, что я бы посчитал ошибкой компилятора :)

Автор: GSerg Размещён: 08.10.2008 04:31

16 плюса

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

Автор: raven Размещён: 08.10.2008 09:02

13 плюса

Решение

Вот то, что я пошел с. Это похоже на ответ 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
Автор: raven Размещён: 14.01.2009 09:42

12 плюса

Я нашел это:

Dim someArray() As Integer

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

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

Автор: raven Размещён: 08.10.2008 03:22

8 плюса

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

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

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

Автор: RS Conley Размещён: 08.10.2008 07:16

5 плюса

В 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
Автор: iCodeInVB6 Размещён: 24.09.2012 07:31

3 плюса

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

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

Автор: SJ00 Размещён: 14.06.2012 03:53

2 плюса

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
Автор: Frodo Размещён: 08.04.2015 05:54

1 плюс

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

Автор: jorge Размещён: 21.01.2012 10:54

1 плюс

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

Он поддерживает код тестирования в соответствии с использованием 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.
Автор: DarrenMB Размещён: 30.04.2015 08:06

1 плюс

Самый простой способ справиться с этим - убедиться, что массив инициализирован заранее, прежде чем вам нужно будет проверить 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
Автор: Kip Densley Размещён: 22.09.2017 04:20

0 плюса

Моя единственная проблема с вызовами 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
Автор: Tim.F Размещён: 12.08.2012 04:14

0 плюса

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
Автор: Senchiu Peter Размещён: 12.07.2016 03:55

0 плюса

Вы можете решить проблему с помощью Ubound()функции, проверяя, является ли массив пустым, получая общее количество элементов, используя VBArray()объект JScript (работает с массивами вариантного типа, одиночного или многомерного):

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, поэтому массив из 10M элементов занимает около 4,1 с. Та же функциональность может быть реализована через ScriptControlActiveX.

Автор: omegastripes Размещён: 13.12.2015 01:36

0 плюса

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

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

Случай 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
Автор: Bucket123 Размещён: 14.09.2016 10:08

0 плюса

В заголовке вопроса спрашивается, как определить, инициализирован ли массив, но после прочтения вопроса похоже, что реальная проблема заключается в том, как получить 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)
Автор: stenci Размещён: 15.02.2018 12:36

0 плюса

Для любой переменной, объявленной как массив, вы можете легко проверить, инициализирован ли массив, вызвав 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
Автор: Scruff Размещён: 29.01.2019 03:24

-1 плюса

Если массив является строковым массивом, вы можете использовать метод 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
Автор: Perry Pederson Размещён: 08.10.2008 04:05

-1 плюса

Я вижу много предложений о том, как определить, был ли массив инициализирован . Ниже приведена функция, которая примет любой массив, проверит, каково значение ubound этого массива, повторно изменит размер массива в ubound +1 (с или без PRESERVER), а затем вернет текущее значение ubound массива без ошибок.

Функция ifuncRedimUbound (ByRef byrefArr, необязательный bPreserve As Boolean)
При ошибке GoTo err:

1: Dim upp%: upp% = (UBound (byrefArr) + 1)

errContinue:

Если bPreserve Тогда
         ReDim Preserve byrefArr (% вверх)
еще
         ReDim byrefArr (% вверх)
Конец, если

ifuncRedimUbound = upp%


Функция выхода
ERR:
Если err.Number = 0, то продолжить дальше
    If err.Number = 9 Then 'индекс вне диапазона (массив еще не был инициализирован)
             Если Erl = 1, то
                         upp% = 0
                         GoTo errContinue:
             Конец, если
    еще
               ErrHandler.ReportError "modArray", ifuncRedimUbound, "1", err.Number, err.Description
    Конец, если
Конечная функция
Автор: Evan TOder Размещён: 26.09.2018 01:17

-2 плюса

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

If IsEmpty(a) Then
    Exit Function
End If

MSDN

Автор: madhu_p Размещён: 25.06.2014 06:52

-8 плюса

Dim someArray() as Integer    

If someArray Is Nothing Then
    Debug.print "this array is not initialised"
End If
Автор: Andrew Harmel-Law Размещён: 08.10.2008 03:28
Вопросы из категории :
32x32