|
Eine der Grundregeln der Programmierung mit Objekten in Visual Basic besagt, dass alle Objekte, die einmal instanziert worden sind, auch wieder terminieren müssen. In der Regel sorgt Visual Basic von alleine dafür, dass zum Programmende alle noch vorhandenen Objekt-Instanzen terminieren. Aber, wie das immer so ist: keine Regel ohne Ausnahme.
Die erste Ausnahme stellen noch geladene Form-Objekte dar. In die Falle, dass zwar das Hauptfenster Ihrer Anwendung geschlossen und entladen worden ist, aber trotzdem aus unerfindlichen Gründen noch irgend welche anderen verborgenen Forms geladen sind, sind Sie sicher wie jeder Visual Basic-Entwickler bereits mehr als einmal hineingetappt. Die Folge ist, dass die Anwendung nur noch brutal über den Taskmanager abzuschießen ist. Nebenbei gesagt: Diese "unerfindlichen" Gründe gibt es eigentlich nicht - es kann eigentlich nur an Ihnen gelegen haben, dass Sie in Ihrem Code vergessen oder übersehen haben, jene(s) Form(s) zu entladen! Visual Basic geht nämlich davon aus, dass ein Programm erst dann tatsächlich beendet werden soll, wenn absolut kein Form mehr geladen ist. Das heißt genau, dass entweder nie irgend ein Form geladen worden ist, oder dass gerade das letzte noch vorhandene Form entladen wurde. Und erst wenn ein Form entladen worden ist, kann das zugehörige Form-Objekt terminieren und sein Terminated-Ereignis ausgelöst werden.
Eine andere Ausnahme stellen so genannte zirkuläre Referenzen dar. Kurz gesagt: Solche zirkulären Referenzen treten beispielsweise auf, wenn sich zwei Objekt-Instanzen jeweils gegenseitig referenzieren. Diese Situation tritt vor allem bei Eltern-Kind-Objekthierarchien auf, wenn sowohl ein Kind-Objekt noch eine Referenz auf sein Eltern-Objekt enthält, wie auch das Eltern-Objekt noch eine Referenz auf das Kind-Objekt. In einem solchen Fall wird zwar Ihre Anwendung von Visual Basic beendet, und auch die per Referenzen verbunden Objekte werden von VB schließlich noch ordentlich terminiert. Doch erfolgt diese Terminierung erst beim tatsächlichen Ende des Programms. Falls Sie schon lange vorher das Eltern- oder das Kind-Objekt loswerden wollen, etwa um Arbeitsspeicher und Ressourcen zurück zu gewinnen, müssen Sie eine zirkuläre Referenz selbst kontrolliert aufheben, etwa durch eine eigene Freigabe-Methode bei einem Kind-Objekt. In dieser wird ausdrücklich die Referenz auf das Eltern-Objekt freigegeben, statt auf das so vorläufig nicht wie erhofft eintreffende Terminate-Ereignis zu warten. Doch je komplexer ein Objekt-Modell und die Kreuz- und Quer-Referenzierungen untereinander werden, um so schwieriger wird es, die Kontrolle über alle notwendigen Freigaben zu behalten, und sicherzustellen, dass alle Freigabe-Aufrufe auch tatsächlich ausgeführt werden.
Ein sehr nützliches Hilfsmittel ist die im Folgenden vorgestellte Klasse bzw. Komponente TrackInstances, die im Debug-Modus in der Entwicklungsumgebung die Verfolgung von Objekt-Instanzen vereinfacht und Ihnen jederzeit den Stand der Instanzierungen einer jeden einzelnen Klasse und eines jedes einzelnen Forms mitteilen kann. Dazu können Sie auch noch die letzten geladenen Forms in einem Rutsch oder nacheinander manuell entladen, wenn diese das Beenden des Programms verhindern sollten, während an sich bereits sämtlicher Code des Programms abgearbeitet worden ist.
Die Klasse TrackInstances ist als globales Objekt (Instancing = 6 - GlobalMultiUse) in einer eigenen Komponente (ActiveX-DLL) angelegt. Sie brauchen lediglich in Ihrem Projekt bzw. in jedem Projekt einer Projekt-Gruppe einen Verweis auf diese Komponente anzulegen. Ob Sie die Komponente kompilieren oder ob Sie sie als Projekt in Projekt-Gruppen aufnehmen, bleibt sich gleich.
Nun braucht es nur noch ein wenig Disziplin Ihrerseits, in jeder Klasse, in jedem Form, in jedem UserControl usw. in deren Initialized- und Terminate-Ereignissen jeweils eine immer gleiche Code-Zeile einzufügen - im Initialized-Ereignis vor Ihrem weiteren Code als erste Zeile, im Terminate-Ereignis nach Ihrem weiteren Code dort als letzte Zeile:
Private Sub XYZ_Initialize()
Debug.Assert Initialized(Me, App.Title)
' ... weiterer Code
End Sub
Private Sub XYZ _Terminate()
' ... weiterer Code
Debug.Assert Terminated(Me, App.Title)
End Sub
Die Aufrufe in der Weise eines Argument zu Debug.Assert sorgen dafür, dass die Methoden Initialized und Terminated nur im Debug-Modus der Entwicklungsumgebung aufgerufen werden und nicht in die ausführbare Version kompiliert werden. Zudem sind die beiden Methoden-Aufrufe als Funktionen angelegt, die als Voreinstellung immer True zurückgegeben und so den Lauf des Programms nicht unterbrechen. Setzen Sie die Eigenschaft TrackDebugAssert dagegen ausdrücklich auf False, wird der Programmlauf nach jeder Rückkehr der Methoden-Aufrufe angehalten.
Mit der Eigenschaft TrackDebugPrint (Voreinstellung = False) legen Sie fest, ob jede Instanzierung und jede Terminierung einer Objekt-Instanz im Debug-Fenster gemeldet werden soll. Und über der Eigenschaft Tracking (Voreinstellung = True) schalten Sie das Instanzen-Tracking ausdrücklich ein oder aus.
Die reine Nachverfolgung der Instanzierungen und Terminierungen ist aber noch nicht alles, was diese Komponente leisten kann. So können Sie jederzeit den Programmlauf unterbrechen und die Methode TrackShow aus dem Debug-Fenster heraus aufrufen. Sie listet daraufhin dort die aktuelle Anzahl der Instanzierungen zusammen mit dem jeweiligen Klassen-Namen auf. Sie können auch optional ausdrücklich einen beliebigen Klassen-Namen als Parameter zu TrackShow angeben - dann wird nur die Anzahl der Instanzierungen dieser Klasse aufgelistet.
Sollte Ihre Anwendung im Debug-Modus in der Entwicklungsumgebung nicht beendet werden, weil noch verdeckte Forms geladen sind, können Sie über die Methode UnloadForms veranlassen (ebenfalls wieder im Direkt-Fenster), dass die noch geladenen Forms in der Reihenfolge ihrer ursprünglichen Instanzierung entladen werden. Sie können jedoch auch den optionalen Parameter OnlyFirst auf True setzen und damit angeben, dass nur das erste gefundene Form entladen werden soll. Oder sie geben im optionalen Parameter FormName den Namen eines bestimmten Forms an, dessen vorhandene Instanzen entladen werden sollen. Setzen Sie auch hierbei den Parameter OnlyFirst auf True, wird auch hier nur die erste gefundene Instanz eines Forms dieses Namens entladen.
Zu guter Letzt gibt es noch die Methode TrackObject. Sie gibt Ihnen aus der Sammlung der instanzierten Objekte eine beliebige Objekt-Instanz zurück, die Sie über den Klassen-Namen (bzw. Form-Namen usw.) und der Index der registrierten Instanz spezifizieren. Dann können Sie, auch wieder im Debug-Fenster, auf Methoden und Eigenschaften dieses Objekts zugreifen - etwa um näher in Erfahrung zu bringen, um welche Instanz es sich handelt, oder um es nach Belieben zu manipulieren:
TrackObject("Form1", 1).Show
In der Komponente werden übrigens keine Referenzen auf die instanzierten Objekte gespeichert, sondern nur die Objekt-Zeiger selbst, die zu jedem Objekt von der (nicht dokumentierten) Visual Basic-Funktion ObjPtr geliefert werden. Erst wenn zur Auflistung beim Aufruf von TrackShow, oder zum Entladen bei UnloadForms, oder beim Aufruf von TrackObject das betreffende Objekt selbst benötigt wird, wird eine - wie gewohnt verwendbare - Referenz davon angelegt. Allerdings geschieht dies ohne Erhöhung des internen Referenz-Zählers - die ansonsten immer im Hintergrund wirkenden COM- und VB-Mechanismen merken nichts von der Existenz solch einer zusätzlichen Referenz. Diese Referenz wird über einen kleinen Trick erzeugt - näheres dazu finden Sie in  "Vom Zeiger zum Objekt".
Zum Abschluss sehen Sie nun noch den kompletten Code der Klasse TrackInstances der Komponente avbTrackInstances:
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (dest As Any, source As Any, _
ByVal bytes As Long)
Private mCounters As Collection
Private pTrackDebugAssert As Boolean
Private pTrackDebugPrint As Boolean
Private pTracking As Boolean
Public Property Get TrackDebugAssert() As Boolean
TrackDebugAssert = pTrackDebugAssert
End Property
Public Property Let TrackDebugAssert _
(New_TrackDebugAssert As Boolean)
pTrackDebugAssert = New_TrackDebugAssert
End Property
Public Property Get TrackDebugPrint() As Boolean
TrackDebugPrint = pTrackDebugPrint
End Property
Public Property Let TrackDebugPrint _
(New_TrackDebugPrint As Boolean)
pTrackDebugPrint = New_TrackDebugPrint
End Property
Public Property Get Tracking() As Boolean
Tracking = pTracking
End Property
Public Property Let Tracking(New_Tracking As Boolean)
pTracking = New_Tracking
End Property
Public Function Initialized(Object As Object, _
Optional AppTitle As String) As Boolean
Dim nKey As String
Dim nInstances As Collection
If Not pTracking Then
Initialized = True
Exit Function
End If
Initialized = pTrackDebugAssert
If StrPtr(AppTitle) = 0 Then
nKey = TypeName(Object)
Else
nKey = AppTitle & "." & TypeName(Object)
End If
If pTrackDebugPrint Then
Debug.Print "Instanziert: ", nKey
End If
If mCounters Is Nothing Then
Set mCounters = New Collection
Set nInstances = New Collection
nInstances.Add ObjPtr(Object), CStr(ObjPtr(Object))
mCounters.Add nInstances, nKey
Else
On Error Resume Next
Set nInstances = mCounters(nKey)
On Error GoTo 0
If nInstances Is Nothing Then
Set nInstances = New Collection
mCounters.Add nInstances, nKey
End If
nInstances.Add ObjPtr(Object), CStr(ObjPtr(Object))
End If
End Function
Public Function Terminated(Object As Object, _
Optional AppTitle As String) As Boolean
Dim nKey As String
Dim nInstances As Collection
If Not pTracking Then
Terminated = True
Exit Function
End If
Terminated = pTrackDebugAssert
If StrPtr(AppTitle) = 0 Then
nKey = TypeName(Object)
Else
nKey = AppTitle & "." & TypeName(Object)
End If
Set nInstances = mCounters(nKey)
nInstances.Remove CStr(ObjPtr(Object))
If nInstances.Count = 0 Then
mCounters.Remove nKey
End If
If pTrackDebugPrint Then
Debug.Print "Terminiert: ", nKey, nInstances.Count
End If
If mCounters.Count = 0 Then
Set mCounters = Nothing
End If
End Function
Public Sub TrackShow(Optional ObjTypeName As String, _
Optional ByVal TrackDebugPrint As Boolean = True)
Dim l As Long
Dim nInstances As Collection
If mCounters Is Nothing Then
If pTrackDebugPrint Or TrackDebugPrint Then
Debug.Print "Keine Referenzen vorhanden."
Debug.Print
End If
Else
If StrPtr(ObjTypeName) = 0 Then
For l = 1 To mCounters.Count
Debug.Print mCounters(l).Count, _
TypeName(zPtrToObject(mCounters(l)(1)))
Next 'l
Else
On Error Resume Next
Set nInstances = mCounters(ObjTypeName)
On Error Resume Next
If pTrackDebugPrint Or TrackDebugPrint Then
If nInstances Is Nothing Then
Debug.Print _
"Keine Referenzen von " & ObjTypeName & " vorhanden."
Else
Debug.Print nInstances.Count, ObjTypeName
End If
Debug.Print
End If
End If
End If
End Sub
Public Function TrackObject(ObjTypeName As String, _
ByVal Index As Long, Optional ByVal Trace As Boolean) _
As Object
If pTracking Then
Set TrackObject = _
zPtrToObject(mCounters(ObjTypeName)(Index))
Debug.Assert Not Trace
End If
End Function
Public Sub UnloadForms(Optional ByVal Trace As Boolean, _
Optional ByVal OnlyFirst As Boolean, Optional FormName As String)
If pTracking Then
Debug.Assert Not Trace
If OnlyFirst And CBool(StrPtr(FormName) = 0) Then
If Not (mCounters Is Nothing) Then
zUnloadFirstForm
End If
Else
Do While Not (mCounters Is Nothing)
If zUnloadFirstForm(OnlyFirst, FormName) Then
Exit Do
End If
Loop
End If
End If
End Sub
Private Function zUnloadFirstForm(ByVal OnlyFirst As Boolean, _
Optional FormName As String) As Boolean
Dim nObject As Object
Dim nInstances As Collection
Dim l As Long
For Each nInstances In mCounters
For l = 1 To nInstances.Count
Set nObject = zPtrToObject(nInstances(l))
If TypeOf nObject Is Form Then
If StrPtr(FormName) = 0 Then
Unload nObject
Exit Function
Else
If TypeName(nObject) = FormName Then
Unload nObject
zUnloadFirstForm = OnlyFirst
Exit Function
End If
End If
End If
Next 'l
Next
zUnloadFirstForm = True
End Function
Private Sub Class_Initialize()
pTrackDebugAssert = True
pTracking = True
End Sub
Private Sub Class_Terminate()
Me.TrackShow False
End Sub
Private Function zPtrToObject(ByVal iObj As Variant) As Object
Dim nObj As Object
If VarType(iObj) = vbLong Then
CopyMemory nObj, CLng(iObj), 4
Else
Exit Function
End If
Set zPtrToObject = nObj
CopyMemory nObj, 0&, 4
End Function
|