ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 20.10.2000

Diese Seite wurde zuletzt aktualisiert am 20.10.2000
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicAddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zur AVB-Web-Site, Kontakt und Impressum

Zurück...

PropertyBagEx

Zurück...


Anzeige

(-hg) mailto:hg_propertybagex@aboutvb.de

Ab Visual Basic 6 können Sie MSDN Library - VB PropertyBagPropertyBag-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"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

Klasse PropertyBagEx (PropertyBagEx.zip - ca. 3,8 KB)



Komponenten-Übersicht

Schnellsuche



Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer