XML-Datei per VisualBasic 6 erweitern

[M Merlin]

Hallo zusammen,
ich habe diesen Thread unter XML schon mal geschrieben...
...da ich dort keine Antwort bekommen habe versuch ich s hier nochmal...

Ich hoffe es hat niemand was dagengen, dass ich es 2 Mal versuch...


Ich möchte eine XML-Datei mit folgenden Childs erstellen:
CalDat und User.
Wenn diese Datei vorhanden ist soll der nächste Eintrag vor allen angefügt werden.

Mein Ansatz sieht wie folgt aus:

Option Explicit
  Private Const FileName As String = "MyFile.XML"
  Private FSO As New FileSystemObject
  ' --> Um Umlaute und Sonderzeichen der deutschen Sprache
  ' --> in einem XML Dokument zuzulassen benötigt man diese ISO Codierung
  Private Const strISO As String = " encoding=""iso-8859-1"""

Private Sub cmdWriteXML_Click()
  On Error Goto errHandler
  Dim oDOM As DOMDocument
  Dim oRoot As IXMLDOMElement
  Dim oInstruct As IXMLDOMProcessingInstruction
  Dim oElemVN As IXMLDOMElement
  Dim oElemNN As IXMLDOMElement
  Dim oElemData As IXMLDOMElement
  Dim oDocType As IXMLDOMDocumentType
  Dim intIDX As Integer
  Dim strXMLInstruct As String
  
  
  Set oDOM = New DOMDocument
  
  'Wenn Datei schon vorhanden, dann laden sonst neu erstellen
  If FSO.FileExists(App.Path & "\" & FileName) = True Then
    oDOM.async = False
    If oDOM.Load(App.Path & "\" & FileName) = False Then
      MsgBox "XML-Datei konnte nicht geladen werden", vbCritical, "Datei laden"
      Exit Sub
    End If
  Else
    'XML Version und die Codierung des Dokumentes festgelegen
    '-> darf nur beim ersten erstellen der Datei erfolgen
    Set oInstruct = oDOM.createProcessingInstruction("xml", "version=""1.0""" & strISO)
    Call oDOM.insertBefore(oInstruct, oDOM.childNodes.Item(0))
  End If
  
  'Wenn Datei noch nicht vorhanden ist das Rootelement einfügen
  'Ist die Datei vorhanden nicht hinzufügen, da nur ein Rootelement vorhanden sein darf
  If FSO.FileExists(App.Path & "\" & FileName) = False Then
    'Rootelement erstellen welches die Datenelement beinhalten soll
    Set oRoot = oDOM.createElement("rsData")
    oDOM.appendChild oRoot
  Else
    Set oRoot = oDOM.documentElement
    MsgBox oRoot.xml

  End If
  
  'anfügen der Daten an das Root Element
  Set oElemData = oDOM.createElement("Datensatz")
  oRoot.appendChild oElemData
  Set oElemVN = oDOM.createElement("CalDate")
  oElemData.appendChild oElemVN
  'Aktuelles Datum einfügen
  oElemVN.Text = Now
  Set oElemNN = oDOM.createElement("User")
  oElemData.appendChild oElemNN
  'Text aus dem Textfeld als User eintragen
  oElemNN.Text = Trim(Me.txtUser.Text)
  
  'Wenn Datei vorhanden den Datensatz an den Anfang einfügen
  If FSO.FileExists(App.Path & "\" & FileName) = True Then
    'Das hier funktioniert so nicht...
    'hat jemand eine Idee was hier rein muss...???
    Call oDOM.insertBefore(oElemVN, oElemData)
  End If
  
  'Datei speichern
  Call oDOM.Save(App.Path & "\" & FileName)
  Exit Sub
  
errHandler:
  MsgBox Err.Description
  Err.Clear
End Sub

Das XML-File sieht nach dem ersten Speichern in etwa so aus:

<rsData>
  <Datensatz>
     <CalDate>04.06.200920:46:09</CalDate>
     <User>MyUser</User>
  </Datensatz>
</rsData>

Nach dem zweiten Speichern sollte das XML-File in etwa so aussehen..

<rsData>
<Datensatz>
     <CalDate>04.06.2009 20:48:09</CalDate>
     <User>MyUser 2</User>
  </Datensatz>
  <Datensatz>
     <CalDate>04.06.2009 20:46:09</CalDate>
     <User>MyUser</User>
  </Datensatz>
</rsData>

Hat jemand eine Idee wie ich das hinbekomme...??

Schon mal Danke....

[NetAktiv]

hallo,
ich habe sowas mit VB.NET gemacht und das sollte leicht adaptierbar sein

Public Shared Function SetParameterXml(ByVal Section As String, ByVal Key As String, ByVal Value As String, Optional ByVal FilePath As String = LEER) As Boolean

'Ein paar Konstante
Private Const LEER As String = ""
Private Const BACKS As String = "\"
Private Const SLASH As String = "/"

Private Const REG_DEF_COMPANY As String = "NetAktiv"
Private Const XML_ROOT_TAG As String = "parameter"
Private Const XML_VALUE_TAG As String = "value"

'Ändern einer XML-Parameter Datei
Dim bResult As Boolean = False
Dim bUpdate As Boolean = False
Dim sXmlKeyPath As String = XML_ROOT_TAG & IIf(Section = LEER, LEER, SLASH).ToString & Section & SLASH & Key
If (FilePath = LEER) Then FilePath = XmlFile

Try
'Falls die Datei nicht existiert, dann erstellen wir eine
If (Not System.IO.File.Exists(FilePath)) Then CreateParameterXmlFile(Section, FilePath)

'Nun lesen wir die Datei ein, die auf jeden Fall existieren sollte.
Dim oXmld As New System.Xml.XmlDocument
oXmld.Load(FilePath)

'Prinzipiell kann es sein, dass die Section auch neu ist, daher fügen wir bei
'Bedarf zunächst die neue Section hinzu
Dim oXmlNode As System.Xml.XmlNode = Nothing
Dim oXmlNodelist As System.Xml.XmlNodeList = Nothing
If (Section <> LEER) Then
oXmlNodelist = oXmld.SelectNodes(XML_ROOT_TAG & SLASH & Section)
If (oXmlNodelist.Count = 0) Then
oXmld.DocumentElement.AppendChild(oXmld.CreateElem ent(Section))
bUpdate = True
End If
End If

'Get the list of name nodes, only one should exist!!!!, but we do not check
oXmlNodelist = oXmld.SelectNodes(sXmlKeyPath)
If (oXmlNodelist.Count = 0) Then
'Der Key existiert noch nicht, also erstellen wir ihn neu
'und setzten das Attribut als Value
Dim oXmlNewElement As System.Xml.XmlElement = oXmld.CreateElement(Key)
oXmlNewElement.SetAttribute(XML_VALUE_TAG, Value)
' Add the element and its attribute to the document
If (Section = LEER) Then
'Unter der Root
oXmld.DocumentElement.AppendChild(oXmlNewElement)
bUpdate = True
Else


'Unter der entsprechenden Sections (auch wenn es nur 1 geben sollte)
oXmlNodelist = oXmld.SelectNodes(XML_ROOT_TAG & SLASH & Section)
For Each oXmlNode In oXmlNodelist
oXmlNode.AppendChild(oXmlNewElement)
bUpdate = True
Next
End If

Else
'Der Key existiert, entweder müssen wir das Attribut überschreiben oder
'neu erstellen. Suche nach dem Value Attribute
oXmlNode = oXmlNodelist.Item(0)
Dim bFound As Boolean = False
For Each oXmlAttribute As System.Xml.XmlAttribute In oXmlNode.Attributes
If (oXmlAttribute.Name = XML_VALUE_TAG) Then
oXmlAttribute.InnerText = Value
bFound = True
bUpdate = True
End If
Next
If (bFound = False) Then
'Attribut nicht gefunden, wir müssen es neu erstellen und hinzufügen
'Dazu brauchen wir das Key-Element, nicht den ganzen Node.
DirectCast(oXmlNode, System.Xml.XmlElement).SetAttribute(XML_VALUE_TAG, Value)
bUpdate = True
End If
End If

'Änderungen speichern, wobei das gefährlich ist, weil wir die alte Datei
'zunächst löschen. Prinzipiell kann das ohne Backup zu Datenverlust führen
If (System.IO.File.Exists(FilePath) = True) Then System.IO.File.Delete(FilePath)
oXmld.Save(FilePath)

'Alles OK
bResult = True
Catch ex As Exception
'Nichts zu tun
End Try
Return bResult

End Function