Узнать проинициализированность массива

[SCINER]

Вот так можно узнать проинициализированность байтового массива:

  Dim B() As Byte
  MsgBox StrPtr(B)

Но я нашел и более универсальный способ, для проверки массива любого типа: код обновлен и приведен ниже...

[B.V.]

Справедливости ради скажу, что метод описан и уже давно опубликован в этой статье: http://vbstreets.ru/VB/Articles/65977.aspx

[SCINER]

ok, тогда так:

Option Explicit
 
Private Declare Sub CopyMemoryArray Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source() As Any, ByVal Length As Long)
 
Function ArrayExists(ar) As Boolean
  Dim lRet As Long
  Dim B() As Byte
  Dim I() As Integer
  Dim L() As Long
  Dim D() As Double
  Dim S() As String
  Dim N() As Single
  Dim C() As Currency
  Dim T() As Date
  Dim V() As Variant
  Select Case TypeName(ar)
  Case "Byte()": B = ar: Call CopyMemoryArray(lRet, B, 4)
  Case "Integer()": I = ar: Call CopyMemoryArray(lRet, I, 4)
  Case "Long()": L = ar: Call CopyMemoryArray(lRet, L, 4)
  Case "Double()": D = ar: Call CopyMemoryArray(lRet, D, 4)
  Case "String()": S = ar: Call CopyMemoryArray(lRet, S, 4)
  Case "Single()": N = ar: Call CopyMemoryArray(lRet, N, 4)
  Case "Currency()": C = ar: Call CopyMemoryArray(lRet, C, 4)
  Case "Date()": T = ar: Call CopyMemoryArray(lRet, T, 4)
  Case "Variant()": V = ar: Call CopyMemoryArray(lRet, V, 4)
  End Select
  ArrayExists = lRet <> 0
End Function
 
Private Sub Form_Load()
  
  Dim lRet As Long
  
  Dim B() As Byte
  Dim I() As Integer
  Dim L() As Long
  Dim D() As Double
  Dim S() As String
  Dim N() As Single
  Dim C() As Currency
  Dim T() As Date
  Dim V() As Variant
 
  Print ArrayExists(B)
  Print ArrayExists(I)
  Print ArrayExists(L)
  Print ArrayExists(D)
  Print ArrayExists(S)
  Print ArrayExists(N)
  Print ArrayExists(C)
  Print ArrayExists(T)
  Print ArrayExists(V)
 
  ReDim B(0)
  ReDim I(0)
  ReDim L(0)
  ReDim D(0)
  ReDim S(0)
  ReDim N(0)
  ReDim C(0)
  ReDim T(0)
  ReDim V(0)
  
  Print vbNullString
 
  Print ArrayExists(B)
  Print ArrayExists(I)
  Print ArrayExists(L)
  Print ArrayExists(D)
  Print ArrayExists(S)
  Print ArrayExists(N)
  Print ArrayExists(C)
  Print ArrayExists(T)
  Print ArrayExists(V)
 
End Sub

[SCINER]

Соответственно, функции(на основе предыдущей) определяющие размерность массивов любых типов, без генерации ошибок:

Function LBoundEx(v) As Long
  If ArrayExists(v) Then
    LBoundEx = LBound(v)
  Else
    LBoundEx = -1
  End If
End Function
 
Function UBoundEx(v) As Long
  If ArrayExists(v) Then
    UBoundEx = UBound(v)
  Else
    UBoundEx = -1
  End If
End Function

[B.V.]

Option Explicit
 
'SAFEARRAY** (указатель на указатель на SAFEARRAY, для всех типов кроме String)
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Arr() As Any) As Long
'Аналог RtlMoveMemory на 4 байта
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
'Копирование участка памяти (что не очевидно из названия функции :) )
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
 
Private StringArray() As String
Private LongArray() As Long
Private DoubleArray() As Double
 
Private Sub Form_Load()
    ReDim LongArray(255) As Long
    MsgBox ArrayExists(StrArrPtr(StringArray)) & vbTab & ArrayExists(ArrPtr(LongArray)) & _
        vbTab & ArrayExists(ArrPtr(DoubleArray))
End Sub
 
'SAFEARRAY* (указатель на SAFEARRAY)
Private Function ArrayExists(ByVal ArrPt As Long) As Long
    GetMem4 ArrPt, VarPtr(ArrayExists)
End Function
 
'SAFEARRAY** (для массива типа String)
Private Function StrArrPtr(ByRef Arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long
    GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)
End Function
 
'Универсальная функция получения указателя
'Можно использовать вместо VarPtr, ArrPtr, StrArrPtr
'А так же для 'User-defined type' массивов
Public Function AnyPtr(ByRef Var As Variant) As Long
    RtlMoveMemory VarPtr(AnyPtr), VarPtr(Var) + 1, 1
    If AnyPtr = 64 Or AnyPtr = 96 Then
        RtlMoveMemory VarPtr(AnyPtr), VarPtr(Var) + 8, 4
    End If
End Function

[Змей]

Цитата SCINER, 04.12.2006, 22:50:17, 1365531

Function ArrayExists(ar) As Boolean

справедливости ради, хотелось бы отметить, что с точки зрения "правильного стиля" следовало бы написАть "Function ArrayExists(ar As Variant) As Boolean", а не полагаться на то, что тип Variant является типом-по-умолчанию-для-неявного-объявления.

[SV()]

Пользуюсь для этого такой штукой:

Public Function ExArr(arr) As Boolean
Dim x As Long
On Error GoTo oppa
x = UBound(arr)
ExArr = True
Exit Function
oppa:
ExArr = False
If Err.Number <> 9 Then
    MsgBox "Неожиданная ошибка! Номер: " & Err.Number & "; Описание: " & Err.Description
End If
End Function

Что у меня не так?

[B.V.]

Цитата SV() @ 22.12.06, 11:38

Что у меня не так?

А почему у тебя должно быть что-то не так?

[SV()]

Возможно некорректно поставил вопрос, т.к. не разбирался в теме досконально
Увидел, так удивился что сразу спросил.
SCINER привёл код около 90 строк, + API
Ваш вариант - около 40 строк, + API
мой вариант - около 15 строк и никакого API

А если кто-то готов писать столько кода для того чтобы не использовать вариант с On Error GoTo, значит этот подход имеет недостатки (мне неизвестные). Вот я и спросил: Что здесь не так?

З.Ы. Или это все было просто из спортивного интереса?

[ALXR]

Без On Error Goto, и без API - еще меньше:

Function IsArrayExists(vArr()) As Boolean
On Error Resume Next
IsArrayExists = True
If Ubound(vArr) = 0 Then If Err.Number = 9 Then Err.Clear: IsArrayExists = False
End Function

В 3 строки.
PS: Пояснение: Если при вычислении UBound(vArr) произошла ошибка, то блок внутри выполняется всегда - без проверки условия.
PPS: А некорректность в возникновении ошибки, как бы правильно ее не обрабатывали. Некрасиво, короче говоря.