Как определить, инициализирован ли массив в VB6?
Передача безразмерного массива в функцию Ubound VB6 вызовет ошибку, поэтому я хочу проверить, был ли он измерен, прежде чем пытаться проверить его верхнюю границу. Как мне это сделать?
24 ответа
Вот то, что я пошел с. Это похоже на ответ 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
Я использую это:
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), но таким образом, что я бы посчитал ошибкой компилятора:)
Я просто подумал об этом. Достаточно просто, никаких вызовов 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) привела бы к ошибке индекса за пределами диапазона.
Я нашел это:
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).
Оба метода GSerg и Raven являются недокументированными взломами, но поскольку Visual BASIC 6 больше не разрабатывается, то это не проблема. Однако пример Raven работает не на всех машинах. Вы должны проверить, как это.
If (Not someArray) = -1, тогда
На некоторых машинах он вернет ноль, на других какое-то большое отрицательное число.
В 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
Поскольку хотел прокомментировать здесь, я отправлю ответ.
Правильный ответ, кажется, от @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
Таким образом, приведенный выше And также рассматривается как побитовый оператор.
Кроме того, стоит проверить, даже если это напрямую не связано с этим,
Оператор Not может быть перегружен, что означает, что класс или структура могут переопределить свое поведение, если его операнд имеет тип этого класса или структуры. Перегрузка
Соответственно, Not интерпретирует массив как его побитовое представление и различает вывод, когда массив пуст или не похож по-разному в форме числа со знаком. Таким образом, можно считать, что это не взлом, это просто недокументированное побитовое представление массива, которое здесь не раскрывается и не используется.
Not принимает один операнд, инвертирует все биты, включая бит знака, и присваивает это значение результату. Это означает, что для положительных чисел со знаком Не всегда возвращает отрицательное значение, а для отрицательных чисел Не всегда возвращает положительное или нулевое значение. Логический побитовый
Решив опубликовать, так как это предложило новый подход, который может быть расширен, дополнен или скорректирован любым, кто имеет доступ к тому, как массивы представлены в их структуре. Итак, если кто-то предлагает доказательство, оно на самом деле не предназначено для обработки массивов с помощью Not bitwise, мы должны принять это как не взлом, а как лучший чистый ответ, если они предлагают или не предлагают какую-либо поддержку этой теории, если она конструктивна комментарии по этому поводу конечно приветствуются.
Это модификация ответа ворона. Без использования 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
Этот также должен работать в случае функции разделения. Ограничение - вам нужно определить тип массива (строка в этом примере).
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
Когда вы инициализируете массив, поставьте целое или логическое значение с флагом = 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.
В заголовке вопроса спрашивается, как определить, инициализирован ли массив, но после прочтения вопроса похоже, что реальная проблема заключается в том, как получить 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-ед (предмет этого вопроса):
UBound(Arr)работает, так зоветUBound2(Arr)добавляет немного накладных расходов, но не сильно болитUBound(Arr)не в функции, которая определяетArr, но преуспевает внутриUBound2()UBound(Arr)терпит неудачу как в функции, которая определяетArrИ вUBound2()так что обработка ошибок делает свою работу- После
Dim Arr() As Whatever, доReDim Arr(X)
Самый простой способ справиться с этим - убедиться, что массив инициализирован заранее, прежде чем вам нужно будет проверить 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
Для любой переменной, объявленной как массив, вы можете легко проверить, инициализирован ли массив, вызвав 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
Любой из этих двух способов подходит для обнаружения неинициализированного массива, но они должны включать круглые скобки:
(Not myArray) = -1
(Not Not myArray) = 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
Моя единственная проблема с вызовами 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
Если массив является строковым массивом, вы можете использовать метод 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
Вы можете решить проблему с 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, поэтому массив из 10M элементов занимает около 4,1 с. Такая же функциональность может быть реализована через ScriptControl ActiveX.
Есть два немного разных сценария для тестирования:
- Массив инициализирован (фактически это не нулевой указатель)
- Массив инициализирован и имеет как минимум один элемент
Случай 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
' Function CountElements return counted elements of an array.
' Returns:
' [ -1]. If the argument is not an array.
' [ 0]. If the argument is a not initialized array.
' [Count of elements]. If the argument is an initialized array.
Private Function CountElements(ByRef vArray As Variant) As Integer
' Check whether the argument is an array.
If (VarType(vArray) And vbArray) <> vbArray Then
' Not an array. CountElements is set to -1.
Let CountElements = -1
Else
On Error Resume Next
' Calculate number of elements in array.
' Scenarios:
' - Array is initialized. CountElements is set to counted elements.
' - Array is NOT initialized. CountElements is never set and keeps its
' initial value of zero (since an error is
' raised).
Let CountElements = (UBound(vArray) - LBound(vArray)) + 1
End If
End Function
' Test of function CountElements.
Dim arrStr() As String
Dim arrV As Variant
Let iCount = CountElements(arrStr) ' arrStr is not initialized, returns 0.
ReDim arrStr(2)
Let iCount = CountElements(arrStr) ' arrStr is initialized, returns 3.
ReDim arrStr(5 To 8)
Let iCount = CountElements(arrStr) ' arrStr is initialized, returns 4.
Let arrV = arrStr
Let iCount = CountElements(arrV) ' arrV contains a boxed arrStr which is initialized, returns 4
Erase arrStr
Let iCount = CountElements(arrStr) ' arrStr size is erased, returns 0.
Let iCount = CountElements(Nothing) ' Nothing is not an array, returns -1.
Let iCount = CountElements(Null) ' Null is not an array, returns -1.
Let iCount = CountElements(5) ' Figure is not an array, returns -1.
Let iCount = CountElements("My imaginary array") ' Text is not an array, returns -1.
Let iCount = CountElements(Array(1, 2, 3, 4, 5)) ' Created array of Integer elements, returns 5.
Let iCount = CountElements(Array("A", "B", "C")) ' Created array of String elements, returns 3.
Я вижу много предложений о том, как определить, был ли массив инициализирован. Ниже приведена функция, которая примет любой массив, проверит, каково значение 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
Конец, если
Конечная функция
Dim someArray() as Integer
If someArray Is Nothing Then
Debug.print "this array is not initialised"
End If