(untagged)

Read/Write/Remove Create XML

Dool_Cookies

0.00/5 (No votes)

25 Aug 2011

XML Function to Read/Write/Remove/Create XML File

Download source code - 8.17 KB

Introduction

This is a simple set of functions that will give the programmer the ability to read/write/remove and create element trees within an XML file.

Read XML Values and Attribute data
Write XML Values and Attribute data (If XML file does not exist, it will create and add passed data to file)
Remove XML Element and Element Tree from XML file
Create new XML Element or Element Tree within an XML file

Background

XML files can be a bit of a pain if you are not used to working with them. And they can require a bit of code to achieve a simple data entry.

I wanted to make a simple set of functions for easily passing data to and from an XML file, and not have to code it each time.

So I came up with the following code function. If you are using VB.NET, then just copy and paste the below code into a new Module.

Using the Code

Demo XML Data

(?xml version"1.0" encoding="UTF-8"?)
(Root)
 (Element1)
  (Value_Other Att="Something")(/Value_Other)
   (Element2)
    (Value_Name)Value(/Value_Name)
   (/Element2)
 (Element1)
(/Root)

Read_XML_Entry(filename,Path,Value_Name) as string

dim a as string
a = Read_XML_Entry ("C:\Some.xml","/Root/Element1/Element2","Value_Name")

Returns - Value

Read_XML_Attribute(Filename,Path,Value_name,Attribute_name) as string

dim a as string
a = Read_XML_Attribute("c:\some.xml","/Root/Element1","Value_Other","Att")

Returns - Something

Write_XML_Value(Filename,Path,Value_Name,Value) as string

dim a as string
a = Write_XML_Value("c:\some.xml","/Root/Element1","Value_Name","Value")

Returns - True if success (False or Error code if not success)
(N.B. Will Create XML File if it does not exist.)

Write_XML_Attribute(Filename,Path,Value_Name,attribute_name,attribute_value) as string

dim a as string
a = Write_XML_Value("c:\some.xml",
	"/Root/Element1/Element2","Value_Name","Att","Something")

Returns - True if success (False or Error code if not success)
(N.B. Will Create XML File if it does not exist.)

Remove_XML_Entry(Filename,Path,Value_Name) as string

dim a as string
a = Remove_XML_Entry("c:\some.xml","/Root/Element1","Value_Other")

Returns - True if success (False or Error code if not success)

Remove_From_Element(Filename,Path) as string

dim a as string
a = Remove_From_Element("c:\some.xml","/Root/Element2")

Returns - True if success (False or Error code if not success)

Create_XML_Tree(filename,start_Path,Path_to_Create) as string

dim a as string
a = Create_XML_Tree("c:\some.xml","/Root/Element1/Element2","/Element3/Element4")

Returns - True if success (False or Error code if not success)

VB.NET Code

Imports System
Imports System.IO
Imports System.Xml
Imports System.Xml.XPath

Module Module1
    ' Private Functions List..... This is were the magic happens =P
    Private Function check_xml_entry(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal value_name As String) As String
        Dim return_value As String
        Try
            Dim xd As New XmlDocument()
            xd.Load(xml_filename)
            ' Find the node where the Person's attribute ID is 1 using its XPath.
            Dim nod As XmlNode = xd.SelectSingleNode(xml_path)
            If nod IsNot Nothing Then
                return_value = "True"
            Else
                return_value = "False"
            End If
            xd.Save(xml_filename)
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function Check_Att(ByVal xml_filename As String, _
    ByVal xpath As String, ByVal value_name As String, ByVal att_name As String) As String
        Dim return_value As String
        Try
            Dim xd As New XmlDocument
            xd.Load(xml_filename)
            Dim nod As XmlNode = xd.SelectSingleNode(xpath & "/" _
            & value_name & "[@" & att_name & "]")
            If nod IsNot Nothing Then
                return_value = "True"
            Else
                return_value = "False"
            End If
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function Out_xml_from_xml_path(ByVal xml_path As String, _
    ByVal value_name As String, ByVal value As String, _
    ByVal att_name As String, ByVal att_value As String) As String
        Dim return_value As String
        Dim a, b, c, d As String
        Dim x, y, z As Integer
        Dim master As String
        Dim buffer As String
        If String.IsNullOrEmpty(att_name) = False Then
            master = "<" & value_name & " " & att_name & "=" & _
            Chr(34) & att_value & Chr(34) & ">" & value & "</" & value_name & ">"
        Else
            master = "<" & value_name & ">" & value & "</" & value_name & ">"
        End If
        a = xml_path.Trim("/")
        x = a.IndexOf("/")
        If x < 1 Then ' Is Root
            return_value = master
            GoTo 1
        End If
        b = a.Remove(0, x + 1)
        d = b
        Do
            x = d.LastIndexOf("/")
            If x < 1 Then ' Is Last Key
                master = "<" & d & ">" & master & "</" & d & ">"
                return_value = master
                Exit Do
            End If
            b = d.Remove(0, x + 1) ' that is without /
            c = d.Remove(0, x) ' that is with /
            master = "<" & b & ">" & master & "</" & b & ">"
            a = d.Replace(c, "")
            d = a
        Loop
1:
        Return master
    End Function
    Private Function Create_New_XML(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal value_name As String, _
    ByVal value As String, ByVal att_name As String, ByVal att_value As String) As String
        Dim return_value As String
        Try
            Dim settings As New XmlWriterSettings()
            settings.Indent = True
            settings.Encoding = System.Text.Encoding.UTF8
            Dim a, b, c, d As String
            Dim XmlWrt As XmlWriter = XmlWriter.Create(xml_filename, settings)
            With XmlWrt
                .WriteStartDocument()
                .WriteComment("XML Document Constructed on " & _
                DateTime.Now.Date & "/" & DateTime.Now.Month & "/" & DateTime.Now.Year)
                .WriteComment("Basic XML File. Create with Code from Dool Cookies")
                .WriteComment("From www.CodeProject.com")
                a = xml_path.Trim("/")
                b = a & "/" & value_name
                For Each t As String In b.Split("/")
                    .WriteStartElement(t)
                Next
                If String.IsNullOrEmpty(att_name) = False Then
                    .WriteAttributeString(att_name, att_value)
                End If
                .WriteString(value)
                .WriteFullEndElement()
                .WriteEndDocument()
                .Close()
                return_value = True
            End With
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function add_to_xml(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal value_name As String, _
    ByVal value As String) As String
        Dim return_value As String
        Try
            Dim cr As String = Environment.NewLine
            Dim dool As String
            dool = Out_xml_from_xml_path(xml_path, value_name, value, Nothing, Nothing)
            Dim xd As New XmlDocument()
            xd.Load(xml_filename)
            Dim docFrag As XmlDocumentFragment = xd.CreateDocumentFragment()
            docFrag.InnerXml = dool
            Dim root As XmlNode = xd.DocumentElement
            root.AppendChild(docFrag)
            xd.Save(xml_filename)
            return_value = "True"
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function Edit_XML_Entry(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal Value_Name As String, _
    ByVal Value As String) As String
        Dim return_value As String
        Dim xd As New XmlDocument()
        xd.Load(xml_filename)
        Dim nod As XmlNode = xd.SelectSingleNode(xml_path & "/" & Value_Name)
        If nod IsNot Nothing Then
            nod.InnerXml = Value
            return_value = "True"
        Else
            return_value = "Dool_Cookies"
        End If
        xd.Save(xml_filename)
        Return return_value
    End Function
    Private Function add_xml_att(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal value_name As String, _
    ByVal att_name As String, ByVal att_value As String) As String
        Dim return_value As String
        Try
            Dim document As New Xml.XmlDocument
            document.Load(xml_filename)
            Dim nav As Xml.XPath.XPathNavigator = document.CreateNavigator
            nav = nav.SelectSingleNode(xml_path & "/" & value_name)
            nav.CreateAttribute(Nothing, att_name, Nothing, att_value)
            document.Save(xml_filename)
            return_value = "True"
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function update_att(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal value_name As String, _
    ByVal att_name As String, ByVal att_value As String) As String
        Dim return_value As String
        Dim xd As New XmlDocument()
        xd.Load(xml_filename)
        Dim nod As XmlNode = xd.SelectSingleNode_
        (xml_path & "/" & value_name & "[@" & att_name & "]")
        If nod IsNot Nothing Then
            nod.Attributes.GetNamedItem(att_name).Value = att_value
            return_value = "True"
        Else
            MsgBox("Opps")
        End If
        xd.Save(xml_filename)
        Return return_value
    End Function
    Private Function Get_ATT(ByVal xml_Filename As String, _
    ByVal xml_path As String, ByVal value_name As String, _
    ByVal att_name As String) As String
        Dim return_value As String
        Try
            Dim a As String
            Dim xd As New XmlDocument
            xd.Load(xml_Filename)
            Dim nod As XmlNode = xd.SelectSingleNode_
            (xml_path & "/" & value_name & "[@" & att_name & "]")
            If nod IsNot Nothing Then
                a = nod.Attributes.GetNamedItem(att_name).Value
                return_value = a
            Else
                return_value = Nothing
            End If
            xd.Save(xml_Filename)
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function Get_Val(ByVal xml_filame As String, _
    ByVal xml_path As String, ByVal value_name As String) As String
        Dim return_value As String
        Try
            Dim a As String
            Dim xd As New XmlDocument
            xd.Load(xml_filame)
            Dim nod As XmlNode = xd.SelectSingleNode(xml_path & "/" & value_name)
            If nod IsNot Nothing Then
                a = nod.InnerXml
                return_value = a
            Else
                return_value = Nothing
            End If
            xd.Save(xml_filame)
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value

    End Function
    Private Function delete_Element(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal value_name As String) As String
        Dim return_value As String
        Try
            Dim document As New Xml.XmlDocument
            document.Load(xml_filename)
            Dim nav As Xml.XPath.XPathNavigator = document.CreateNavigator
            nav = nav.SelectSingleNode(xml_path & "/" & value_name)
            nav.DeleteSelf()
            document.Save(xml_filename)
            return_value = "True"
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function delete_tree(ByVal xml_filename As String, _
    ByVal xml_path As String) As String
        Dim return_value As String
        Try
            Dim document As New Xml.XmlDocument
            document.Load(xml_filename)
            Dim nav As Xml.XPath.XPathNavigator = document.CreateNavigator
            nav = nav.SelectSingleNode(xml_path)
            nav.DeleteSelf()
            document.Save(xml_filename)
            return_value = "True"
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function create_tree(ByVal xml_filename As String, _
    ByVal start_at As String, ByVal add_these As String) As String
        Dim return_value As String
        Dim a, b, c, d As String
        Try
            Dim document As New Xml.XmlDocument
            document.Load(xml_filename)
            Dim nav As Xml.XPath.XPathNavigator = document.CreateNavigator
            nav = nav.SelectSingleNode(start_at)
            a = add_these.Trim("/")
            b = start_at
            For Each t As String In a.Split("/")
                b = b & "/" & t
                nav.AppendChildElement(Nothing, t, Nothing, "")
                nav = nav.SelectSingleNode(b)
            Next
            document.Save(xml_filename)
            return_value = "True"
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    Private Function dool_cookies(ByVal xml_filename As String, _
    ByVal xml_path As String, ByVal value_name As String, _
    ByVal value As String) As String
        Dim return_value As String
        Try
            Dim dool As New XmlDocument
            dool.Load(xml_filename)
            Dim nav As Xml.XPath.XPathNavigator = dool.CreateNavigator
            nav = nav.SelectSingleNode(xml_path)
            nav.AppendChildElement(Nothing, value_name, Nothing, value)
            dool.Save(xml_filename)
            return_value = "True"
        Catch ex As Exception
            return_value = ex.Message
        End Try
        Return return_value
    End Function
    ' Public Functions List........
    Public Function Write_XML_Value_
    (ByVal XML_Filename As String, ByVal XML_Path As String, _
    ByVal Value_Name As String, ByVal Value As String) As String
        Dim return_value As String
        Dim a, b, c, d As String
        If File.Exists(XML_Filename) = False Then
            a = Create_New_XML(XML_Filename, _
		XML_Path, Value_Name, Value, Nothing, Nothing)
            return_value = a
            GoTo 1
        End If
        a = check_xml_entry(XML_Filename, XML_Path, _
			Value_Name) ' Check to see if entry exists.

        If a.ToLower = "true" Then ' Yes we need to update the value
            b = Edit_XML_Entry(XML_Filename, XML_Path, Value_Name, Value)
            return_value = b
            If b.ToLower = "dool_cookies" Then
                c = dool_cookies(XML_Filename, XML_Path, Value_Name, Value)
                return_value = c
            End If

        Else ' No we need to make a new value
            b = add_to_xml(XML_Filename, XML_Path, Value_Name, Value)
            return_value = b
        End If
1:
        Return return_value
    End Function
    Public Function Write_XML_Attribute_
    (ByVal XML_FileName As String, ByVal XML_Path As String, _
    ByVal Value_Name As String, ByVal Attribute_Name As String, _
    ByVal Attribute_Value As String) As String
        Dim return_value As String
        Dim a, b, c As String
        If File.Exists(XML_FileName) = False Then
            a = Create_New_XML(XML_FileName, XML_Path, _
            Value_Name, Nothing, Attribute_Name, Attribute_Value)
            return_value = a
            GoTo 1
        End If
        a = Check_Att(XML_FileName, XML_Path, Value_Name, Attribute_Name)
        If a.ToLower = "true" Then ' Att does exists, update
            a = update_att(XML_FileName, XML_Path, _
            Value_Name, Attribute_Name, Attribute_Value)
            return_value = a
        Else ' create new one.
            a = add_xml_att(XML_FileName, XML_Path, _
            Value_Name, Attribute_Name, Attribute_Value)
            return_value = a
        End If
1:
        Return return_value
    End Function
    Public Function Read_XML_Value_
    (ByVal XML_Filename As String, ByVal XML_Path As String, _
    ByVal Value_Name As String) As String
        Dim return_value As String
        Dim a As String
        If File.Exists(XML_Filename) = False Then
            return_value = "File Does Not Exist"
            GoTo 1
        End If
        a = Get_Val(XML_Filename, XML_Path, Value_Name)
        return_value = a
1:
        Return return_value
    End Function
    Public Function Read_XML_Attribute_
    (ByVal XML_Filename As String, ByVal XML_Path As String, _
    ByVal Value_Name As String, ByVal Attribute_Name As String) As String
        Dim return_value As String
        Dim a As String
        If File.Exists(XML_Filename) = False Then
            return_value = "File Does Not Exist"
            GoTo 1
        End If
        a = Get_ATT(XML_Filename, XML_Path, Value_Name, Attribute_Name)
        return_value = a
1:
        Return return_value
    End Function
    Public Function Remove_XML_Entry_
    (ByVal XML_Filename As String, ByVal XML_Path As String, _
    ByVal Value_Name As String) As String
        Dim return_value As String
        Dim a As String
        If File.Exists(XML_Filename) = False Then
            return_value = "File Does Not Exist"
            GoTo 1
        End If
        a = delete_Element(XML_Filename, XML_Path, Value_Name)
        return_value = a
1:
        Return return_value
    End Function
    Public Function Remove_From_Element_
    (ByVal XML_Filename As String, ByVal XML_Path As String) As String
        Dim return_value As String
        Dim a As String
        If File.Exists(XML_Filename) = False Then
            return_value = "File Does Not Exist"
            GoTo 1
        End If
        a = delete_tree(XML_Filename, XML_Path)
        return_value = a
1:
        Return return_value
    End Function
    Public Function Create_XML_Tree(ByVal xml_filename As String, _
    ByVal Create_at_xml_path As String, ByVal Extra_Tree_Elements As String) As String
        Dim return_value As String
        Dim a As String
        If File.Exists(xml_filename) = False Then
            return_value = "File Does Not Exist"
            GoTo 1
        End If
        a = create_tree(xml_filename, Create_at_xml_path, Extra_Tree_Elements)
        return_value = a
1:
        Return return_value
    End Function

End Module

Points of Interest

I learnt that an XML Path is case sensitive. And while it was a fun thing to undertake writing this, I found that it has been really useful to whack into a DLL file.

History

This is the first release of my code. And it will not let you make duplicate entries in an XML file. I kinda put this in myself as I don't like duplicates.

If there are any updates needed to the code, please feel free to email them to me and I will update the code section.

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here