27 Agt 2013

Membaca dan Modifikasi file XML pada VB.NET

Anggap saja anda tau dengan XML, bagi saya menggunakan file XML pada pemrograman VB.NET adalah membu... thumbnail 1 summary
Anggap saja anda tau dengan XML, bagi saya menggunakan file XML pada pemrograman VB.NET adalah membuat aplikasi customize yang bisa kita kelola sendiri. Walaupun ada Resource atau Setting pada VB.NET, entah kenapa saya lebih enakan pakai XML untuk menyimpan beberapa data.

- Class XML
Pertama saya akan membuat sebuah class dengan nama XML.vb pada project.
Klik Kanan pada project -> Class

Lalu paling atas file XML.vb saya meng-import library :

Imports System
Imports System.IO
Imports System.Reflection
Imports System.Xml

Di bawah tag Class XML (Public Class XML) buatlah kode seperti di bawah ini :

 Public XMLFile As String = ""
    Public XMLRoot As String = "root"

    Private xmldoc As New XmlDocument
    Private xmldoc_loaded As Boolean = False

    Public Sub Reset()
        xmldoc_loaded = False
        XMLFile = ""
        XMLRoot = "root"
      
        xmldoc = Nothing
        xmldoc = New XmlDocument
    End Sub

    Public Function SaveXML(Optional ByVal sFile As String = "") As Boolean
        Dim ret As Boolean = True
     
        If sFile.Trim.Length > 0 Then XMLFile = sFile.Trim
       
       
        Try
            xmldoc.Save(XMLFile)
        Catch ex As Exception
            ret = False
        End Try
        Return ret
    End Function

    Public Function LoadXML(Optional ByVal sFile As String = "",Optional ByVal sRoot As String = "") As Boolean
        Dim success As Boolean = True
       
        If sFile.Trim.Length > 0 Then XMLFile = sFile.Trim
      
        If sRoot.Trim.Length > 0 Then XMLRoot = sRoot.Trim
       
        If XMLFile.Trim.Length < 1 Then Return False
       
        Dim f As New IO.FileInfo(XMLFile)
        success = f.Exists
        f = Nothing
        If Not success Then Return False
      
        xmldoc = Nothing
        xmldoc = New XmlDocument
      
        Try
            Dim s As Stream = File.OpenRead(XMLFile)
            Dim sread As New StreamReader(s)
            xmldoc.LoadXml(sread.ReadToEnd)
            sread.Close()
        Catch ex As Exception
            success = False
        End Try
        If success Then xmldoc_loaded = True
        Return success
    End Function

    Private Function GetMainNode(ByVal Section As String) As String
      
        Return "/" & XMLRoot & "/" & Section
    End Function

    Public Function GetValue(ByVal Section As String, ByVal sKey As String) As String
        Dim ret As String = ""
      
        If Not xmldoc_loaded Then Return ret
        Dim nname As String = GetMainNode(Section)
      
        Dim nlist As XmlNodeList = xmldoc.SelectNodes(nname)
       
        For Each node As XmlNode In nlist

            If node.HasChildNodes Then
             
                For Each child As XmlNode In node.ChildNodes
                  
                    If child.LocalName.ToLower.Trim = sKey.ToLower.Trim Then
                    
                        ret &= child.InnerText.Trim.Replace("%lt%", "<").Replace("%gt%", ">")
                        Exit For
                    End If
                Next
            End If
          
            If ret.Length > 0 Then Exit For
        Next
        Return ret
    End Function

    Public Function GetAllValues(ByVal Section As String) As String()
        Dim ret As String() = {}
        Dim s As String = ""
      
        If Not xmldoc_loaded Then Return ret
        Dim nname As String = GetMainNode(Section)
      
        Dim nlist As XmlNodeList = xmldoc.SelectNodes(nname)
       
        For Each node As XmlNode In nlist
          
            If node.HasChildNodes Then
               
                For Each child As XmlNode In node.ChildNodes
                  
                    If child.InnerText.Trim.Length > 0 Then
                      
                        If Len(s) > 0 Then s &= Chr(254)
                      
                        s &= child.InnerText.Trim.Replace("%lt%", "<").Replace("%gt%", ">")
                    End If
                Next
                ret = s.Split(Chr(254))
            End If
        Next
        Return ret
    End Function

    Public Sub SetValue(ByVal Section As String, ByVal sKey As String,ByVal sValue As String)
        Dim nname As String = GetMainNode(Section)
        Dim nlist As XmlNodeList
        Dim newnode As XmlNode
        Dim found As Boolean = False
        If xmldoc.SelectNodes(XMLRoot).Count < 1 Then
           
            Dim rnode As XmlNode = xmldoc.CreateElement(XMLRoot)
            xmldoc.AppendChild(rnode)
        End If
        If xmldoc.SelectNodes(nname).Count < 1 Then
          
            Dim rnode As XmlNode = xmldoc.SelectNodes(XMLRoot).Item(0)
            Dim snode As XmlNode = xmldoc.CreateElement(Section)
            rnode.AppendChild(snode)
        End If
        nlist = xmldoc.SelectNodes(nname)
       
        For Each node As XmlNode In nlist
          
            If node.HasChildNodes And Not found Then
                For Each child As XmlNode In node.ChildNodes
                    If child.LocalName.ToLower.Trim = sKey.Trim.ToLower Then

                        child.InnerText = sValue.Trim.Replace("<", "%lt%").Replace(">", "%gt%")
                        found = True
                        Exit For
                    End If
                Next
                If Not found Then
                  
                    newnode = xmldoc.CreateElement(sKey)
                  
                    newnode.InnerText =sValue.Trim.Replace("<", "%lt%").Replace(">", "%gt%")
                    node.AppendChild(newnode)
                    found = True
                End If
            Else
              
                newnode = xmldoc.CreateElement(sKey)
              
                newnode.InnerText =sValue.Trim.Replace("<", "%lt%").Replace(">", "%gt%")
                node.AppendChild(newnode)
                found = True
            End If
            If found Then Exit For
        Next
    End Sub

    Protected Overrides Sub Finalize()
      
        xmldoc = Nothing
        MyBase.Finalize()
    End Sub

- XML File
Beberapa fungsi yang dibuat pada class XML tersebut dengan nama tes.xml. Sekarang buatlah file XML pada project. Klik kanan -> Add -> New Item -> Cari XML File


Lalu ubah properties pada tes.XML Copy to Output Copy if newer. Ini berfungsi untuk selalu mengcopy file saat menjalankan debug F5


Klik 2x pada tes.xml, lalu ketikkan kode, klo modifikasi pun tidak apa-apa :
<?xml version="1.0" encoding="utf-8" ?>
<root>
  <configuration>
    <nama>Bonsai Teknologi</nama>
    <alamat>Jl Kemerdekaan</alamat>
    <tlp>1231231</tlp>
  </configuration>
</root>
Jadi ada section "root","configuration" lalu node "nama","alamat","tlp"



- MODULE For Call XML Class Event
Buatlah sebuah module , Klik kanan project ->  Module . buat nama Module1.vb

Klik 2x pada module, lalu ketikkan :
1. Import library
Imports System
Imports System.IO
Imports System.IO.File
2. Kode :
Dim xml = New XML

    Private Function _LoadXMLSetting() As Boolean

        If File.Exists(BasePath() & "\tes.xml") Then
            xml.LoadXML(BasePath() & "\tes.xml", "root")
            Return True

        Else
            MsgBox("Kesalahan : Konfigurasi tidak ada" & BasePath())
            Return False
        End If
    End Function
    Public Sub _SaveSetting(ByVal sKey As String, ByVal sValue As String)
        If _LoadXMLSetting() Then
            xml.SetValue("configuration", sKey, sValue)
            xml.SaveXML()
        Else
            MsgBox("Kesalahan : Konfigurasi tidak ada")
        End If

    End Sub

    Function _GetSetting(ByVal sKey As String) As String
        Dim p As String = ""
        If _LoadXMLSetting() Then
            p = xml.GetValue("configuration", sKey)
        Else
            MsgBox("Kesalahan : Konfigurasi tidak ada")
        End If


        Return p
    End Function

    Function BasePath() As String
        Dim path As String = AppDomain.CurrentDomain.BaseDirectory
        Dim path1 As String = path.Replace("\bin\Debug\", "")
        Dim basepath2 As String = ""

        If IO.Directory.Exists(path1) Then
            basepath2 = path1
        ElseIf IO.Directory.Exists(path) Then
            basepath2 = path
        Else
            MsgBox("Path tidak ditemukan")
        End If
        Return basepath2

       End Function
 Keterangan :
- _LoadXMLSetting() = Fungsi untuk cek file tes.xml , dengan load data section "root"
- _SaveSetting = Menyimpan data ke file XML, dengan load data section "configuration"
- _GetSetting = Mengambil data dari file XML, dengan load data section "configuration"
- BasePath() = Mengambil alamat file saat di debug ataupun pada folder project

Jadi logikanya :
Cek file tes.xml -> (jika ada) -> load tes.xml ambil section "root" -> (jika ada section root) -> Baca section "configuration" -> (jika ada) -> baca data node dari "configuration

- CALL DATA XML to a Form Input
Sekarang kembali pada Form, lalu buatlah desain seperti ini



Klik 2x pada bagian Form kosong (Event Form_Load), lalu ketikkan :
 Me.TextBox1.Text = _GetSetting("nama")
        Me.TextBox2.Text = _GetSetting("alamat")
        Me.TextBox3.Text = _GetSetting("tlp")
Debug F5, lihat hasilnya