vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Dateisystem · XML   |   VB-Versionen: VB4, VB5, VB627.03.06
XML-Verwaltung leicht gemacht (inkl. XPath)

XML ist ein mächtiges System, mit diesem kleinen Modul wird die Grundverwaltung zum Kinderspiel

Autor:   Florian PlatzerBewertung:     [ Jetzt bewerten ]Views:  27.062 
www.vbmaster.gbadmin.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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:
Fügen Sie der Form 3 CommandButtons hinzu:

  • cmdCreate ("Erstellen")
  • cmdTest ("Testwerte speichern")
  • cmdDelete ("Main-Werte löschen")
Fügen Sie folgenden Code in den Codeteil der Form:

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

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!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.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel