Click here to Skip to main content
12,293,873 members (66,485 online)
Click here to Skip to main content
Add your own
alternative version

Tagged as

Stats

33.7K views
2.1K downloads
25 bookmarked
Posted

Read/Write/Remove Create XML

, 25 Aug 2011 CPOL
Rate this:
Please Sign up or sign in to vote.
XML Function to Read/Write/Remove/Create XML File

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, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

Dool_Cookies
Classified
Australia Australia
Programming for fun =)

You may also be interested in...

Comments and Discussions

 
QuestionWhy not XLINQ? Pin
Sacha Barber25-Aug-11 2:30
mvpSacha Barber25-Aug-11 2:30 
I would just use XLINQ which has now been around for nearly 4 years, I wrote an article which shows its usage a while back if you are interested : XLINQ Introduction Part 3 Of 3, it shows the same sort of things you show here.

Still if you are doing stuff for PRE .NET 3.5, then great.
Sacha Barber
  • Microsoft Visual C# MVP 2008-2011
  • Codeproject MVP 2008-2011
Open Source Projects
Cinch SL/WPF MVVM

Your best friend is you.
I'm my best friend too. We share the same views, and hardly ever argue

My Blog : sachabarber.net

AnswerRe: Why not XLINQ? Pin
Dool_Cookies1-Sep-11 16:46
memberDool_Cookies1-Sep-11 16:46 
GeneralRe: Why not XLINQ? Pin
Sacha Barber5-Sep-11 21:31
mvpSacha Barber5-Sep-11 21:31 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

| Advertise | Privacy | Terms of Use | Mobile
Web01 | 2.8.160525.2 | Last Updated 25 Aug 2011
Article Copyright 2011 by Dool_Cookies
Everything else Copyright © CodeProject, 1999-2016
Layout: fixed | fluid