Viele Entwickler lassen sich von der Komplexität des "XML-Systems" abschrecken und verzichten deshalb darauf. Leider lassen sie sich dadurch einiges entgehen, denn wer sich wirklich mit XML auseinandersetzt, erkennt die klaren Vorteile gegenüber einer Ini-Datei, der Registry bzw. einer extra angelegten Mini-DB. Zwar gibt es auf vb@rchiv schon einige XML-Tipps, dieses Modul, welches ich Ihnen hier vorstellen, kapselt die wichtigsten Funktionen und ist somit individuell einsatzbereit (verwendete XML-Version: 2). Besonderes Feature: Unterstützung von XPath Erstellen Sie ein neues Projkekt (Standard-EXE), aktivieren den Verweis "Microsoft XML, v2..." und fügen Sie dem Projekt ein Modul hinzu mit folgendem Code hinzu. Option Explicit ' ############################## ' #### FileExists-Function ##### Private Const INVALID_HANDLE_VALUE = -1 Private Const MAX_PATH = 260 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Declare Function FindFirstFile Lib "Kernel32" _ Alias "FindFirstFileA" ( _ ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "Kernel32" ( _ ByVal hFindFile As Long) As Long ' #### FileExists-Function ##### ' ############################## ' Konstante für den Kopf der Datei (natürlich beliebig ersetzbar) Private Const sXMLHeader As String = "Header" ' Typ beim Füllen eines XML-Objekts Public Enum XMLType xFile = 0 xString = 1 End Enum ' Variable für den aktuell verwendeten Pfad Private sXMLPath As String Private oXML As MSXML2.DOMDocument Private oElement As IXMLDOMElement ' ############################## ' #### FileExists-Function ##### Public Function FileExists(ByVal sFile As String) As Boolean Dim WFD As WIN32_FIND_DATA Dim hFile As Long hFile = FindFirstFile(sFile, WFD) FileExists = hFile <> INVALID_HANDLE_VALUE Call FindClose(hFile) End Function Public Sub XML_Init() ' XML-Objekt wird instanziert Set oXML = New MSXML2.DOMDocument End Sub Public Sub XML_DeInit() ' XML-Objekt wird gelöscht Set oXML = Nothing End Sub ' Erstellen einer neuen XML-Datei und Speichern unter dem übergebenen Dateinamen ' Bereits existierende Datei wird überschrieben Public Function Create(ByVal sFileName As String) As Boolean Create = False If sFileName <> "" Then If FileExists(sFileName) Then Kill sFileName If FileExists(sFileName) Then Err.Raise 70 Else Set oXML = New MSXML2.DOMDocument oXML.async = False Call oXML.Save(sFileName) sXMLPath = sFileName Create = True End If Else Err.Raise 52 End If End Function ' Speichern der Daten Public Sub WriteData(ByVal sQuery As String, ByVal sValue As String) Dim sElements() As String Dim sXPath As String Dim n As Integer Dim sData As String sQuery = sXMLHeader & "/" & sQuery sElements = Split(sQuery, "/") sXPath = "" On Error Resume Next For n = LBound(sElements) To UBound(sElements) sXPath = sXPath & sElements(n) Err.Clear sData = oXML.getElementsByTagName(sXPath).Item(0).Text If Err.Number <> 0 Then Set oElement = oXML.createElement(sElements(n)) Err.Clear If oXML.getElementsByTagName(sXPath).length = 0 Then If n = LBound(sElements) Then oXML.appendChild oElement Else oXML.getElementsByTagName(Left(sXPath, Len(sXPath) - Len(sElements(n)) - 1)).Item(0).appendChild oElement End If Else oXML.getElementsByTagName(sXPath).Item(0).appendChild oElement End If If n = UBound(sElements) Then oElement.Text = sValue If Err.Number <> 0 Then Err.Raise Err.Number End If sXPath = sXPath & "/" Next n On Error GoTo 0 End Sub ' Lesen der Daten (Default-Wert wird verwendet, ' sollte das Laden eines gespeicherten Wertes fehlschlagen ' (z.B. wenn er nicht existiert) Public Function ReadData(ByVal sQuery As String, Optional ByVal sDefault As String = "") As String On Error Resume Next Err.Clear ReadData = oXML.getElementsByTagName(sQuery).Item(0).Text If Err.Number <> 0 Then ReadData = sDefault On Error GoTo 0 End Function ' Löschen eines Knotens Public Function DeleteData(ByVal sQuery As String) As Boolean On Error Resume Next Dim oDeleteNode As MSXML2.IXMLDOMNode Set oDeleteNode = oXML.selectSingleNode(sXMLHeader & "/" & sQuery) Call oDeleteNode.parentNode.removeChild(oDeleteNode) DeleteData = (Err.Number = 0) On Error GoTo 0 End Function ' Füllen eines XML-Objekts Public Function Load(ByVal sSource As String, Optional oType As XMLType = xFile) As Boolean Set oXML = New MSXML2.DOMDocument oXML.async = False Select Case oType Case xFile Load = oXML.Load(sSource) sXMLPath = sSource Case xString Load = oXML.loadXML(sSource) End Select If oXML.parseError.errorCode <> 0 Then MsgBox "Fehler beim Laden:" & vbCrLf & vbCrLf & "#: " & _ oXML.parseError.errorCode & vbCrLf & "Zeile: " & _ oXML.parseError.Line & vbCrLf & "Position: " & _ oXML.parseError.linepos & vbCrLf & "Beschreibung: " & _ oXML.parseError.reason & vbCrLf, vbExclamation, "XML Parse Error" Load = False End If End Function ' Speichern: Sollte über Load(oType:=xFile) ' oder Create eine Datei erstelt worden sein, muss kein Dateiname ' übergeben werden, ansonsten schon Public Function Save(Optional ByVal sFileName As String = "") As Boolean Save = False If sFileName = "" Then sFileName = sXMLPath If sFileName = "" Then Err.Raise 52 Exit Function End If If FileExists(sFileName) Then Kill sFileName If FileExists(sFileName) Then Err.Raise 70 Exit Function End If oXML.Save sFileName Save = True End Function ' Gibt den aktuellen Dateinamen zurück ' (z.B. als Sicherheitsüberprüfung vor dem Speichern sinnvoll) Public Function FileName(Optional ByVal bFullPath As Boolean = False, _ Optional ByVal bFileType As Boolean = True) As String FileName = IIf(bFullPath, sXMLPath, _ Right(sXMLPath, Len(sXMLPath) - InStrRev(sXMLPath, "\"))) If Not bFileType Then FileName = Left(FileName, InStrRev(FileName, ".") - 1) End Function Nun zum Beispielprojekt:
Option Explicit Private Sub cmdCreate_Click() XML_Init Call Create(App.Path & "\data.xml") cmdTest.Enabled = True cmdDelete.Enabled = True End Sub Private Sub cmdDelete_Click() Call DeleteData("main_info") Call DeleteData("main_version") Call Save End Sub Private Sub cmdTest_Click() Call WriteData("main_info", "test-xml") Call WriteData("main_version", "1.0") Call WriteData("data/data_folder_1", "data1_1") Call WriteData("data/data_folder_1", "data1_2") Call WriteData("data/data_folder_1", "data1_3") Call WriteData("data/data_folder_1", "data1_4") Call WriteData("data/data_folder_1", "data1_5") Call WriteData("data/data_folder_2", "data2_1") Call WriteData("data/data_folder_2", "data2_2") Call WriteData("data/data_folder_2", "data2_3") Call WriteData("data/data_folder_2", "data2_4") Call WriteData("data/data_folder_2", "data2_5") Call WriteData("user/name", "Florian") Call WriteData("user/adress", "xyz") Call WriteData("user/mail", "a@b.c") Call WriteData("extra/long/path/to/show/xpath/function/in/module", "great ;)") Call Save End Sub Viel Spaß beim Testen Dieser Tipp wurde bereits 27.062 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 (einschl. Beispielprojekt!) 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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. |
||||||||||||||||
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. |