Zainicjowana tablica. Access i VBA

Czy tablica jest zainicjowana?

Możemy napisać krótką, ale brzydką funkcję, która w argumencie typu Variant pobierze sprawdzaną tablicę vArray i w której za pomocą instrukcji On Error Resume Next wyłączymy obsługę błędów, co powoduje, że jeżeli wystąpi błąd, sterowanie przejdzie do instrukcji znajdującej się bezpośrednio po instrukcji, której wykonanie spowodowało błąd. Sprawdzamy, czy dolny indeks jest prawidłowy (numeryczny) za pomocą instrukcji
IsArrayAllocated = IsNumeric(LBound(vArray)).
Jeżeli wystąpi błąd wykonania funkcja zakończy się zwracając False. I prawie jest dobrze, ale z małym wyjątkiem.

Jeżeli zadeklarujemy zmienną Dim vArray As Variant jako typ Variant i za pomocą instrukcji Array
vArray = Array() przypiszemy do zmiennej vArray tablicę, to otrzymamy w wyniku TRUE, co informuje nas, że tablica jest zainicjowana. Jednak próba odwołania się do pierwszego elementu tablicy vArray(0)
kończy się wcześniej opisanym błędem nr 9. Funkcja LBound(vArray) zwraca 0, a funkcja LBound(vArray) zwraca -1. Obie wartości są numeryczne, więc dlatego jest prawie dobrze. Jeżeli dodamy jeszcze jedną linijkę, w której sprawdzimy, czy dolny indeks jest mniejszy od górnego, to będzie już naprawdę dobrze:

IsArrayAllocated = CBool(LBound(vArray) <= UBound(vArray))

Możemy na początku dopisać jeszcze jedną instrukcję, w której sprawdzimy czy argument vArray jest tablicą, by niepotrzebnie nie sprawdzać dolnego indeksu argumentu, który nie jest tablicą:
If IsArray(vArray) Then Exit Function

Public Function IsArrayAllocated(vArray As Variant) As Boolean
	If IsArray(vArray) Then
		On Error Resume Next
			IsArrayAllocated = IsNumeric(LBound(vArray))
			IsArrayAllocated = CBool(LBound(vArray) <= UBound(vArray))
		On Error GoTo 0
	End If
End Function

Inny sposób na sprawdzenie, czy tablica jest zainicjowana.

Można też napisać trzy jednolinijkowe funkcje, pozwalającą sprawdzić czy tablica określonego typu jest zainicjowana. Poniżej przedstawiam trzy funkcje, dla typu Long, Integer i Byte.

Public Function IsInitializedArrayLong(arrLong() As Long) As Boolean
	IsInitializedArrayLong = (Not arrLong) <> -1
End Function

Public Function IsInitializedArrayInteger(arrInteger() As Integer) As Boolean
	IsInitializedArrayInteger = (Not arrInteger) <> -1
End Function

Public Function IsInitializedArrayByte(arrByte() As Byte) As Boolean
	IsInitializedArrayByte = (Not arrByte) <> -1
End Function

• Ile tablica ma wymiarów?

W podobny sposób jak w funkcji IsArrayAllocated(...) tzn. z wyłączoną obsługą błędów za pomocą instrukcji On Error Resume Next w pętli sprawdzać będziemy czy dolny indeks kolejnych wymiarów tablicy jest wartością numeryczną. W każdym kroku pętli licznik zostaje zwiększony o 1 (i = i + 1),

IsNumeric(LBound(vArray, i))

aż do wystąpienia błędu. Wartość zmiennej i wskazuje na pierwszy nieprawidłowy wymiar tablicy. Wystarczy tylko odjąć 1, by uzyskać ilość wymiarów tablicy:

Function ArrayDimensions(vArray As Variant) As Integer
	Dim i As Long
	On Error Resume Next
		Do
			i = i + 1
			IsNumeric (LBound(vArray, i))
			If Err.Number <> 0 Then Exit Do
		Loop
	On Error GoTo 0
	ArrayDimensions = i - 1
End Function

• SAFEARRAY, VarPtr, deskryptor, wskaźnik, flaga VT_ARRAY i VT_BYREF.

• Czyli trochę inne podejście do tematu „Czy tablica jest zainicjowana?”

Przedstawię trochę inne podejście do tematu „Czy tablica jest zainicjowana?”. Najpierw słów kilka o tablicy i organizacji danych w tablicy. Wszystkie niezbędne informacje o tablicy znajdują się w strukturze SAFEARRAY

SAFEARRAY jest deskryptorem tablicy. Zawiera różne informacje dotyczące aktualnego wystąpienia tablicy, m in. takie jak liczba wymiarów tablicy, rozmiar pojedynczego elementu, liczba blokad oraz wskaźnik do danych tablicy (pvData). Dolny indeks i ilość elementów każdego wymiaru przechowywane są w elemencie rgsabound będącego tablicą zawierającą strukturę SAFEARRAYBOUND dla każdego wymiaru.
- Dostęp do informacji o tablicy i danych zawartych w tablicy realizowany jest w kodzie za pomocą wskaźnika (lptrSA) do jej deskryptora SAFEARRAY, czyli SAFEARRAY *
Tablicę do funkcji sprawdzającej vbaIsArrayAllocated(ByRef vArray As Variant) będziemy przekazywali w argumencie typu Variant. Zmienna tego typu rezerwuje pierwsze 8 bajtów na dane określające rodzaj zmiennej. Pierwsze 2 bajty przechowują informacje o Typie Danych (VarType).
Dostęp do Typu Danych zmiennej vArray realizowany jest poprzez wskaźnik to zmiennej lptrArray lptrArray = VarPtr(vArray) by następnie za pomocą funkcji CopyMemory pobrać dane o typie danych zmiennej Variant
CopyMemory vt, ByVal lptrArray, ByVal 2
Nas najbardziej interesują dwie wartości (flagi):

• VT_ARRAY

jeżeli flaga ta jest ustawiona, informuje że przekazana zmienna vArray jest tablicą,

• VT_BYREF

określająca sposób dostępu do struktury SAFEARRAY. Jeżeli flaga ta jest ustawiona wskazuje, że lptrSA jest wskaźnikiem do wskaźnika do struktury SAFEARRAY. Nieustawiona flaga określa, że lptrSA jest wskaźnikiem do struktury SAFEARRAY.

Mając najpotrzebniejsze informacje o strukturze tabeli, możemy przystąpić do odczytu potrzebnych nam danych. Najbardziej interesuje nas element cDims struktury SAFEARRAY zawierający dane o ilości wymiarów tablicy. W celu sprawdzenia czy tablica jest zainicjowana musimy pobrać (spróbować pobrać) element cElements struktury SAFEARRAYBOUND z ostatniego elementu tablicy rgsabound() będącej elementem struktury SAFEARRAY.

' tablica z danymi dla każdego wymiaru
Private Type SAFEARRAYBOUND
    cElements   As Long             ' ilość elementów w wymiarze
    lLbound     As Long             ' najniższy indeks wymiaru
End Type

Private Type SAFEARRAY
    cDims       As Integer          ' liczba wymiarów tablicy
    fFeatures   As Integer          ' flagi dot. właściwości danych
    cbElements  As Long             ' rozmiar  pojedynczego elementu
    cLocks      As Long             ' liczba blokad bez odblokowania
    #If VBA7 Then
        pvData  As LongPtr          ' wskaźnik do danych
    #Else
        pvData  As Long             ' wskaźnik do danych
    #End If
    rgsabound(1) As SAFEARRAYBOUND  ' dane dla każdego wymiaru
End Type

⊗ Public Function vbaIsArrayAllocated(ByRef vArray As Variant) As Long

Pobiera wskaźnik lptrArray do przekazanej w argumencie vArray zmiennej i wczytuje do zmiennej vt dwa pierwsze bajty z deskryptora zmiennej Variant.
W zmiennej vt flaga VT_ARRAY musi być ustawiona, gdyż argument vArray ma wskazywać na tablicę. W przeciwnym wypadku funkcja kończy działanie. Następnie pobierany jest wskaźnik lptrSA do struktury SAFEARRAY. Jeżeli w zmiennej vt flaga VT_BYREF jest ustawiona, to lptrSA jest wskaźnikiem do wskaźnika do struktury SAFEARRAY, co wymusza ponowne pobranie nowego wskaźnika. Jeżeli nowy wskaźnik lptrSA jest równy ZERO, to tablica nie jest zainicjowana.
Dla wartości wskaźnika lptrSA większej od Zera pobierany jest ze struktury SAFEARRAY element iDims określający ilość wymiarów tablicy. Wartość elementu iDims większa od Zera nie wskazuje jednoznacznie, że tablica została zainicjowana. Przypadek ten dotyczy zmiennej Variant zawierającej niezainicjowaną tablicę vArray = Array(). Dopiero ilość elementów cElements struktury SAFEARRAYBOUND z ostatniego elementu tablicy rgsabound() będącej elementem struktury SAFEARRAY równa ZERO jednoznacznie określa, że tablica nie jest zainicjowana.
argumenty:
- vArray
- zmienna typu Variant zawierającą tablicę.
zwraca:
Jeżeli przekazana w argumencie tablica jest zainicjowana zwraca ilość wymiarów tablicy. Jeżeli tablica nie jest zainicjowana zwraca ZERO.
autor: Zbigniew Bratko
data: 03.02.2019

Option Compare Database
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" ( _
        Destination As Any, _
        source As Any, _
        ByVal Length As LongPtr)
#Else
  Private Declare Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (Destination As Any, _
        Source As Any, _
        ByVal Length As Long)
#End If

Public Function vbaIsArrayAllocated(ByRef vArray As Variant) As Long
Dim vt            As Integer      ' kombinacja stałych (VT_) określająca typ danych
Dim iDims         As Integer      ' ilość wymiarów tablicy
Dim lElements     As Long         ' ilość elementów w wymiarze tablicy
Dim lLbound       As Long         ' dolny indeks wymiaru
Dim i             As Long
Dim k             As Long
Const VT_BYREF = &H4000&          ' flaga - wskaźnik przekazany przez wskaźnik
Const VT_ARRAY = &H2000&          ' flaga = vbArray - tablica
Const conLenVarDscr As Long = 8   ' wielkość deskryptora zmiennej Variant
   
#If VBA7 Then
  Dim lptrSA        As LongPtr    ' wskaźnik do struktury SAFEARRAY
  Dim lptrArray     As LongPtr    ' wskaźnik do zmiennej vArray
  Const conLengthSA As Long = 24  ' offset do tablicy rgsabound[1]
#Else
  Dim lptrSA        As Long       ' wskaźnik do struktury SAFEARRAY
  Dim lptrArray     As Long       ' wskaźnik do wskaźnik do zmiennej vArray
  Const conLengthSA As Long = 16  ' offset do tablicy rgsabound[1]
#End If

	' pobierz wskaźnik to zmiennej vArray
	lptrArray = VarPtr(vArray)

	'pobierz VarType z deskryptora zmiennej Variant (dwa pierwsze bajty)
	CopyMemory vt, ByVal lptrArray, ByVal 2

	' jeżeli zmienna vArray nie jest tablicą => wyjdź
	If (vt And VT_ARRAY) <> VT_ARRAY Then Exit Function

	'pobierz wskaźnik lptrSA do struktury SAFEARRAY
	CopyMemory lptrSA, ByVal lptrArray + conLenVarDscr, ByVal LenB(lptrArray)

	'tablica jest niezainicjowana => wyjdź
	If lptrSA = 0 Then Exit Function

	' sprawdź, czy lptrSA jest wskaźnikiem do struktury SAFEARRAY,
	' czy wskaźnikiem do wskaźnika do struktury SAFEARRAY
	If (vt And VT_BYREF) = VT_BYREF Then
		'pobierz wskaźnik do struktury SAFEARRAY
		CopyMemory lptrSA, ByVal lptrSA, ByVal LenB(lptrSA)
	End If

	'tablica jest niezainicjowana => wyjdź
	If lptrSA = 0 Then Exit Function

	'pobierz ilość wymiarów tablicy
	CopyMemory iDims, ByVal lptrSA, ByVal 2

	'tablica nie jest zainicjowana
	If iDims <= 0 Then Exit Function

	' lptrSA > 0 i intDims > 0 ;Sprawdź ostatecznie, czy tablica
	' jest zainicjowana: przypadek: vArray = Array()
	CopyMemory lElements, ByVal (lptrSA + conLengthSA), ByVal 4

	' jeżeli brak elementu w ostatnim wymiarze tablicy => wyjdź
	If lElements = 0 Then Exit Function

	vbaIsArrayAllocated = iDims

	' pętla tylko demonstruje, jak można pobrać ilość elementów
	' i dolny indeks poszczególnych wymiarów tablicy
	Debug.Print "=== Pętla w funkcji vbaIsArrayAllocated(...) ==="
	For i = (2 * iDims - 1) To 0 Step -2
		k = k + 1
		CopyMemory lLbound, ByVal (lptrSA + conLengthSA + (i) * 4), ByVal 4
		Debug.Print "   Wymiar " & k & ":"
		Debug.Print "LBound = " & lLbound,
		CopyMemory lElements, ByVal (lptrSA + conLengthSA + (i - 1) * 4), ByVal 4
		Debug.Print "Elementów = " & lElements
	Next

End Function

Jeszcze tylko przykładowe wywołanie funkcji vbaIsArrayAllocated(...)

Public Function funTest()
Dim iDims As Long
Dim i     As Long
Dim arrMyArray(2 To 5, -7 To -3, -12 To 15) As Long

	iDims = vbaIsArrayAllocated(arrMyArray)

	Debug.Print "========= Funkcja testowa funTest (...) =========="
	For i = 1 To iDims
		Debug.Print "   Wymiar " & ": " & i
		Debug.Print "LBound = " & LBound(arrMyArray, i),
		Debug.Print "Elementów = " & _
								(UBound(arrMyArray, i) - LBound(arrMyArray, i)) + 1
	Next
End Function

Wyniki przykładowego wywołania