VB 5/6-Tipp 0571: Array auf Dimensionierung überprüfen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"

' Autor: Stefan Maag <maag@odn.de>

Option Explicit

Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias "GetMem4" _
                    (pArray() As Any, sfaPtr As Long)

Dim arr() As Long

Private Sub Command1_Click()
   ' Auf Dimensionierung überprüfen
   Dim sfaPtr As Long
   
   GetSafeArrayPointer arr(), sfaPtr
   
   If sfaPtr > 0 Then
      MsgBox "dimensioniert"
   Else
      MsgBox "undimensioniert"
   End If

End Sub

Private Sub Command2_Click()
   ' Array Dimensionalisieren
   ReDim arr(10)
End Sub

Private Sub Command3_Click()
   ' Array undimensionieren (Dimensionen löschen)
   Erase arr()
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Kommentar von Christian Pryor am 11.09.2007 um 09:09

Wer keine globalen Variablen prüfen will, sondern eine kompakte Funktion sucht, kann diesen Code verwenden.
Er funktioniert im Grunde so wie GetSafeArrayPointer.

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Function isArrayInitialized(arr As Variant) As Boolean
Dim Addr As Long
Dim Addr2 As Long
   CopyMemory Addr, ByVal VarPtr(arr) + 8, 4
   CopyMemory ByVal VarPtr(Addr2), ByVal Addr, 4
   isArrayInitialized = (Addr2 > 0)
End Function

Kommentar von Christoph Scholzen am 07.09.2006 um 23:49

@Philipp
Hast recht - auf der ganzen Linie!

In meinen Notizen steht zur von mir geposteten Methode folgender Kommentar:
' -> akzeptiert nur solche Arrays als initialisiert, die ohne
' Redimensionierung mind. ein Element aufnehmen koennen.

Wenn ich meine IF-Abfrage um "Or LBound(arr) <= UBound(arr)"
erweitere, erfüllt sie diesen Anspruch auch weiterhin, ABER:

1.) ich wusste nicht, dass VB Arrays mit Index-Werten < 0 verarbeiten
kann: sehr interessant: zwar kein unverzichtbares Feature, kann aber zur
Eleganz des Codes beitragen.
2.) wenn ich mir überlege, in welchen Situationen ich die von mir gepostete
Methode verwende, dann drängt sich die Erkenntnis auf, dass die von Dir
vorgeschlagene API-Func, die ich wegen den erwähnten "Schwächen" bisher
verworfen habe, eigentlich fast immer genügt.

Ist immer schön, dazuzulernen!

Kommentar von Philipp Stephani am 28.08.2006 um 18:49

@Christoph:

Dein Code erkennt fälschlicherweise Array, deren Obergrenze manuell auf negative Werte festgelegt wurde, als nicht initialisiert:

Dim x(-5 To -3) As Long
Debug.Print isArrayInitialized(x) 'ergibt "False"

Außerdem sind Arrays, wie sie von der Array- oder Split-Funktion zurückgegeben werden, immer initialisiert, sie enthalten nur manchmal keine Elemente:

Dim y As Variant
y = Array() 'oder Split("")
Debug.Print IsArray(y), LBound(y), UBound(y) 'True, 0, -1

Die in diesem Tipp vorgestellte Möglichkeit prüft als einzige zuverlässig auf Initialisierung.

Kommentar von Christoph Scholzen am 28.08.2006 um 17:15

Dieser Code akzeptiert auch Arrays als initialisiert, wenn
UBound(arr) == -1 ist, wie das z.B. hier der Fall ist:
arr = Array()

Ich verwende jeweils folgende Function:

Private Function isArrayInitialized(arr As Variant) As Boolean
On Error GoTo NotInitialized
If UBound(arr) > -1 Then
isArrayInitialized = True
Exit Function
End If
NotInitialized:
isArrayInitialized = False
End Function

Kommentar von Philipp Stephani am 09.09.2005 um 05:56

Siehe auch !faq67.

Kommentar von Philipp Stephani am 09.11.2004 um 18:34

@Reinhard Grothaus:
Die Möglichkeit scheint oft zu Fehlern zu führen und ich würde sie nicht verwenden.

Kommentar von Reinhard Grothaus am 09.02.2003 um 07:46

Guter Tipp, aber so geht es noch viel einfacher:
Dim stText()

If (Not Not stText) = 0 Then
MsgBox "Undimensioniert"
Else
MsgBox "Dimensioniert"
End If