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 ' 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 Dieser Tipp wurde bereits 12.476 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |