it-swarm.com.ru

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

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

49
raven

Вот то, что я пошел с. Это похоже на answer 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
13
raven

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

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

22
GSerg

Я просто подумал об этом. Достаточно просто, никаких вызовов API не требуется. Есть проблемы с этим?

Public Function IsArrayInitialized(arr) As Boolean

  Dim rv As Long

  On Error Resume Next

  rv = UBound(arr)
  IsArrayInitialized = (Err.Number = 0)

End Function

Edit : я обнаружил недостаток, связанный с поведением функции Split (на самом деле я бы назвал это недостатком в функции Split). Возьмите этот пример:

Dim arr() As String

arr = Split(vbNullString, ",")
Debug.Print UBound(arr)

Каково значение Ubound (обр) в этой точке? Это -1! Таким образом, передача этого массива в эту функцию IsArrayInitialized вернула бы значение true, но попытка доступа к arr (0) привела бы к ошибке индекса вне диапазона.

16
raven

Я нашел это:

Dim someArray() As Integer

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

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

12
raven

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

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

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

8
RS Conley

В 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
5
iCodeInVB6

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

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

3
SJ00
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
2
Frodo

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

Он поддерживает код тестирования в соответствии с использованием UBOUND и не требует использования обработки ошибок для тестирования.

Он IS зависит от нулевых массивов (что имеет место в большинстве разработок).

Не следует использовать «Стереть», чтобы очистить массив. используйте альтернативу, указанную ниже.

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.
1
DarrenMB

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

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

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

1
jorge

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

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

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

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

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

Вы можете решить эту проблему с помощью функции 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 с. Та же функциональность может быть реализована через ScriptControl ActiveX.

0
omegastripes