|
Ab Visual Basic 6 können Sie  PropertyBag-Objekte
selbst instanzieren. Und da das PropertyBag-Objekt zu den wenigen
Objekten aus Visual Basic gehört, die eine Implements-taugliche
Schnittstelle haben, können Sie auch problemlos eigene Klassen
entwickeln, die die Fähigkeiten des PropertyBag-Objekts erweitern.
Überall dort, wo die ursprüngliche Schnittstelle erwartet wird,
etwa bei der Übergabe an serialisierbare Klassen, können Sie Ihre
eigene PropertyBag-Klasse übergeben - sie wird trotzdem wie das
Original akzeptiert und behandelt.
Eine Möglichkeit, das PropertyBag-Objekt zu erweitern, zeigen
wir Ihnen in  "PropertyBag
im PropertyBag". Eine weitere Möglichkeit wäre,
ein PropertyBag-Objekt mit der Fähigkeit zu versehen, sich selbst
in eine Datei zu speichern bzw. seinen Inhalt aus einer Datei
auszulesen. Sie können den dafür notwendigen Code zwar auch selbst
"drumherum" schreiben - doch warum die unnötige Arbeit,
wenn Sie dieses Feature des öfteren brauchen?
Zunächst implementieren Sie die originale Schnittstelle in einer
neuen Klasse (PropertyBagEx) und sehen eine interne Variable für
ein originales PropertyBag-Objekt vor:
Implements PropertyBag
Private mPropBag As PropertyBag
In den Klassen-Ereignissen Class_Initialize und Class-Terminate
instanzieren Sie das PropertyBag-Objekt bzw. geben es wieder frei:
Private Sub Class_Initialize()
Set mPropBag = New PropertyBag
End Sub
Private Sub Class_Terminate()
Set mPropBag = Nothing
End Sub
Die Aufrufe der Eigenschaft Contents und der Methoden
ReadProperty und WriteProperty der PropertyBag-Schnittstelle reichen
Sie direkt an das interne PropertyBag-Objekt durch:
Private Property Get PropertyBag_Contents() As Variant
PropertyBag_Contents = mPropBag.Contents
End Property
Private Property Let PropertyBag_Contents _
(ByVal New_Contents As Variant)
mPropBag.Contents = New_Contents
End Property
Private Function PropertyBag_ReadProperty(ByVal Name As String, _
Optional ByVal DefaultValue As Variant) As Variant
PropertyBag_ReadProperty = mPropBag.ReadProperty(Name, _
DefaultValue)
End Function
Private Sub PropertyBag_WriteProperty(ByVal Name As String, _
ByVal Value As Variant, _
Optional ByVal DefaultValue As Variant)
mPropBag.WriteProperty Name, Value, DefaultValue
End Sub
Damit Sie Ihre PropertyBagEx-Klasse auch ohne umständliche
Typumwandlungen wie das originale PropertyBag-Objekt verwenden
können, sehen Sie diese Eigenschaft und diese Methoden bei ihr
ebenfalls vor. Auch hier reichen Sie die Aufrufe direkt an das
interne PropertyBag-Objekt durch:
Public Property Get Contents() As Variant
Contents = mPropBag.Contents
End Property
Public Property Let Contents(ByVal New_Contents As Variant)
mPropBag.Contents = New_Contents
End Property
Public Function ReadProperty(ByVal Name As String, _
Optional ByVal DefaultValue As Variant) As Variant
ReadProperty = mPropBag.ReadProperty(Name, DefaultValue)
End Function
Public Sub WriteProperty(ByVal Name As String, _
ByVal Value As Variant, _
Optional ByVal DefaultValue As Variant)
mPropBag.WriteProperty Name, Value, DefaultValue
End Sub
Nun kommen als Erweiterung in Ihrer Klasse die beiden Methoden
ReadFromFile und SaveToFile (und die kleine private Hilfsfunktion
zFileExist, die prüft, ob eine Datei bereits existiert) hinzu:
Public Enum PropertyBagExErrors
pbxErrFileNotFound = vbObjectError + 10001
pbxErrFileExists = vbObjectError + 10002
End Enum
Public Sub ReadFromFile(FilePath As String)
Dim nFNr As Integer
Dim nContents As Variant
Dim nPropBag As PropertyBag
If zFileExist(FilePath) Then
On Error GoTo ReadFromFile_Error
nFNr = FreeFile
Open FilePath For Binary Access Read Lock Read As #nFNr
Get #nFNr, , nContents
Close #nFNr
Me.Contents = nContents
Else
Err.Raise pbxErrFileNotFound, "PropertyBagEx.ReadFromFile"
End If
Exit Sub
ReadFromFile_Error:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
Public Sub SaveToFile(FilePath As String, _
Optional ByVal OverWrite As Boolean = True)
Dim nPropBag As PropertyBag
Dim nContents As Variant
Dim nFNr As Integer
If zFileExist(FilePath) And Not OverWrite Then
Err.Raise pbxErrFileExists, "PropertyBagEx.SaveToFile"
End If
nContents = Me.Contents
On Error Resume Next
Kill FilePath
On Error GoTo SaveToFile_Error
nFNr = FreeFile
Open FilePath For Binary Access Write Lock Write As #nFNr
Put #nFNr, , nContents
Close #nFNr
Exit Sub
SaveToFile_Error:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
Private Function zFileExist(FilePathName As String) As Boolean
Dim nFlags As Integer
nFlags = vbNormal Or vbHidden Or vbSystem Or vbArchive
On Error GoTo FileExist_Error
If Len(Trim$(FilePathName)) Then
If Len(Dir$(FilePathName)) Then
zFileExist = CBool(GetAttr(FilePathName) Or nFlags)
End If
End If
Exit Function
FileExist_Error:
End Function
|