vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Verschiedenes / Sonstiges   |   VB-Versionen: VB.NET14.02.06
Leistungsstarkes PropertyBag für VB.NET

Speichert diverse Informationen wie z.B Programmeinstellungen intelligent ab

Autor:   R.RohrbachBewertung:  Views:  10.900 
ohne HomepageSystem:  WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10kein Beispielprojekt 

Mit diesem Klassenmodul lassen sich diverse Informationen, wie z.B. Programmeinstellungen etc., intelligent speichern.

Beispiel:

Dim test As New cls_PropertyBag(Of String, String)
Dim w As New cls_PropertyBag(Of String, String)
 
test.AddValue("Text", "Kleine Demo", "Mein Programm", "MainForm", "Projekt 1", "txt_Eingabe")
 
' anderes Bag mit Infos initalisieren
w.Contents = test.Contents
 
Call MsgBox(w.GetValue("Text", "Mein Programm", "MainForm", "Projekt 1", "txt_Eingabe"))
 
' Einstellungen auf Platte schreiben
Call w.SaveContentsToFile("C:\Test\Einstellungen.dat")
 
' und wieder einlesen
test.ReadContentsFromFile("C:\Test\Einstellungen.dat")

Die Klasse cls_PropertyBag
Erstellen Sie ein neues Klassenmodul mit folgendem Code:

' 2006 - R.Rohrbach <rrohrbach@hotmail.com>
 
Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
 
<Serializable()> _
Public Class cls_PropertyBag(Of UserTypeValue, UserTypeNode)
 
  <Serializable()> _
  Private Class cls_NHashTable
    Public Keys As New Hashtable, Values As New Hashtable
    Public Node As UserTypeNode, PreNode As UserTypeNode
 
    Public Sub New()
 
    End Sub
 
    Public Sub New(ByVal vName As UserTypeNode)
      Node = vName
    End Sub
 
  End Class
 
  Private MainHash As New cls_NHashTable()
  Private tOverride As Boolean
 
  <NonSerialized()> Dim pContents As String
  <NonSerialized()> Private binForm As New BinaryFormatter()
  <NonSerialized()> Private mStream As New MemoryStream()
 
  Public Sub RemoveKey(ByVal key As UserTypeNode, ByVal ParamArray Nodes() As UserTypeNode)
    Try
      Call RemoveKeyRecursiveWithHash(key, MainHash, 0, Nodes)
    Catch
    End Try
  End Sub
 
  Private Sub RemoveKeyRecursiveWithHash(ByRef ValueKey As UserTypeNode, _
    ByRef ParentHash As cls_NHashTable, ByVal Stufe As Integer, _
    ByVal ParamArray Nodes() As UserTypeNode)
 
    Try
      If Stufe > UBound(Nodes) Then
        Call ParentHash.Values.Remove(ValueKey)
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Call RemoveKeyRecursiveWithHash(ValueKey, _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Sub
 
  Public Function GetNodeValuesAsHash(ByVal ParamArray Nodes() As UserTypeNode) _
    As Hashtable
 
    Try
      Return GetNodeValuesAsHashRecursiveWithHash(MainHash, 0, Nodes)
    Catch
    End Try
  End Function
 
  Private Function GetNodeValuesAsHashRecursiveWithHash( _
    ByRef ParentHash As cls_NHashTable, ByVal Stufe As Integer, _
    ByVal ParamArray Nodes() As UserTypeNode) As Hashtable
 
    Try
      If Stufe > UBound(Nodes) Then
        Return ParentHash.Values
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Return GetNodeValuesAsHashRecursiveWithHash( _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      Else
        Return Nothing
      End If
    Catch
    End Try
  End Function
 
  Public Sub ClearValuesInNode(ByVal ParamArray Nodes() As UserTypeNode)
    Try
      Call ClearValuesInNodeRecursiveWithHash(MainHash, 0, Nodes)
    Catch
    End Try
  End Sub
 
  Private Sub ClearValuesInNodeRecursiveWithHash( _
    ByRef ParentHash As cls_NHashTable, ByVal Stufe As Integer, _
    ByVal ParamArray Nodes() As UserTypeNode)
 
    Try
      If Stufe > UBound(Nodes) - 1 Then
        Call ParentHash.Values.Clear()
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Call ClearValuesInNodeRecursiveWithHash( _
        CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
        Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Sub
 
  Public Sub RemoveNode(ByVal ParamArray Nodes() As UserTypeNode)
    Try
      Call RemoveNodeRecursiveWithHash(MainHash, 0, Nodes)
    Catch
    End Try
  End Sub
 
  Private Sub RemoveNodeRecursiveWithHash(ByRef ParentHash As cls_NHashTable, _
    ByVal Stufe As Integer, ByVal ParamArray Nodes() As UserTypeNode)
 
    Try
      If Stufe > UBound(Nodes) - 1 Then
        Call ParentHash.Keys.Remove(Nodes(Stufe))
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Call RemoveNodeRecursiveWithHash( _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Sub
 
  Public Function GetNodeValuesCount(ByVal ParamArray Nodes() As UserTypeNode) As Long
    Try
      Return GetNodeCoundRecursiveWithHash(MainHash, 0, Nodes)
    Catch
    End Try
  End Function
 
  Private Function GetNodeCoundRecursiveWithHash( _
    ByRef ParentHash As cls_NHashTable, ByVal Stufe As Integer, _
    ByVal ParamArray Nodes() As UserTypeNode) As Long
 
    Try
      If Stufe > UBound(Nodes) Then
        Return ParentHash.Values.Count
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Return GetNodeCoundRecursiveWithHash( _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Function
 
  Public Function ExistNode(ByVal ParamArray Nodes() As UserTypeNode) As Boolean
    Try
      Return ExistNodeRecursiveWithHash(MainHash, 0, Nodes)
    Catch
    End Try
  End Function
 
  Private Function ExistNodeRecursiveWithHash( _
    ByRef ParentHash As cls_NHashTable, ByVal Stufe As Integer, _
    ByVal ParamArray Nodes() As UserTypeNode) As Boolean
 
    Try
      If Stufe > UBound(Nodes) Then
        Return True
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Return ExistNodeRecursiveWithHash( _
        CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
        Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Function
 
  Public Function ExistKey(ByVal key As UserTypeNode, _
    ByVal ParamArray Nodes() As UserTypeNode) As Boolean
 
    Try
      Return ExistKeyRecursiveWithHash(key, MainHash, 0, Nodes)
    Catch
    End Try
  End Function
 
  Private Function ExistKeyRecursiveWithHash(ByRef ValueKey As UserTypeNode, ByRef _
    ParentHash As cls_NHashTable, ByVal Stufe As Integer, _
    ByVal ParamArray Nodes() As UserTypeNode) As Boolean
 
    Try
      If Stufe > UBound(Nodes) Then
        Return ParentHash.Values.ContainsKey(ValueKey)
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Return ExistKeyRecursiveWithHash(ValueKey, _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Function
 
  Public Function GetValue(ByVal key As UserTypeNode, _
    ByVal ParamArray Nodes() As UserTypeNode) As UserTypeValue
 
    Try
      Return GetValueRecursiveWithHash(key, MainHash, 0, Nodes)
    Catch
    End Try
  End Function
 
  Private Function GetValueRecursiveWithHash( _
    ByRef ValueKey As UserTypeNode, ByRef ParentHash As cls_NHashTable, _
    ByVal Stufe As Integer, _
    ByVal ParamArray Nodes() As UserTypeNode) As UserTypeValue
 
    Try
      If Stufe > UBound(Nodes) Then
        If ParentHash.Values.ContainsKey(ValueKey) Then 
          Return CType(ParentHash.Values.Item(ValueKey), UserTypeValue)
        End If
        Exit Function
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Return GetValueRecursiveWithHash(ValueKey, _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Function
 
  Public Function AddValue(ByVal key As UserTypeNode, _
    ByVal value As UserTypeValue, _
    ByVal ParamArray Nodes() As UserTypeNode) As Boolean
 
    Try
      Call AddValueRecursiveWithHash(value, key, MainHash, 0, Nodes)
    Catch
    End Try
  End Function
 
  Private Sub AddValueRecursiveWithHash(ByRef ValueToAdd As UserTypeValue, _
    ByRef ValueKey As UserTypeNode, ByRef ParentHash As cls_NHashTable, _
    ByVal Stufe As Integer, ByVal ParamArray Nodes() As UserTypeNode)
 
    Try
      If Stufe > UBound(Nodes) Then
        If ParentHash.Values.ContainsKey(ValueKey) Then
          If Override = False Then Exit Sub
          ParentHash.Values.Remove(ValueKey)
        End If
        ParentHash.Values.Add(ValueKey, ValueToAdd)
      ElseIf ParentHash.Keys.ContainsKey(Nodes(Stufe)) Then
        Call AddValueRecursiveWithHash(ValueToAdd, ValueKey, _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      Else
        Call ParentHash.Keys.Add(Nodes(Stufe), New cls_NHashTable(Nodes(Stufe)))
        CType(ParentHash.Keys.Item(Nodes(Stufe)), _
          cls_NHashTable).PreNode = ParentHash.Node
        Call AddValueRecursiveWithHash(ValueToAdd, ValueKey, _
          CType(ParentHash.Keys.Item(Nodes(Stufe)), cls_NHashTable), _
          Stufe + 1, Nodes)
      End If
    Catch
    End Try
  End Sub
 
  Public Sub SaveContentsToFile(ByVal Path As String)
    Dim sw As StreamWriter
    Try
      sw = New StreamWriter(Path)
      Call sw.Write(Contents)
    Finally
      sw.Close()
    End Try
  End Sub
 
  Public Sub ReadContentsFromFile(ByVal Path As String)
    Dim StrReader As StreamReader
    Try
      StrReader = New StreamReader(Path)
      Contents = StrReader.ReadToEnd
    Catch
    End Try
  End Sub
 
  Public Sub New()
    Override = True
   End Sub
 
  Public Property Override() As Boolean
    Get
      Return tOverride
    End Get
 
    Set(ByVal Value As Boolean)
      tOverride = Value
    End Set
  End Property
 
  Public Property Contents() As String
    Get
      Try
        Call binForm.Serialize(mStream, Me)
        Return Convert.ToBase64String(mStream.ToArray)
      Catch
      End Try
    End Get
 
    Set(ByVal Value As String)
      ' Unterschiedliche Generics können natürlich nicht 
      ' ineinander konvertiert werden
      Try
        MainHash = DirectCast(binForm.Deserialize(New MemoryStream( _
          Convert.FromBase64String(Value))), _
          cls_PropertyBag(Of UserTypeValue, UserTypeNode)).MainHash
      Catch
      End Try
    End Set
  End Property
End Class



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2019 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.