fLaSh_CF
Banido
Boas;
Coloco aqui uma classe para fácil acesso ao XML.
Ideal para guardar informações como configurações da aplicação, registos, etc..
A "classe" contem um Namespace com duas classes cXML e cTag..
cXML é o principal motor da engine a cTag serve apenas para guardar temporariamente cada registo que sera armazenado em um Hashtable (collection)
Nota: os comentarios estão em EG, fiz o project sample para o PSC, talvez mais tarde eu traduza para PT
Depois de as classes colucadas, pequeno exemple de como utilizar:
Fica com este aspecto:
Enjoy!
Coloco aqui uma classe para fácil acesso ao XML.
Ideal para guardar informações como configurações da aplicação, registos, etc..
A "classe" contem um Namespace com duas classes cXML e cTag..
cXML é o principal motor da engine a cTag serve apenas para guardar temporariamente cada registo que sera armazenado em um Hashtable (collection)
Nota: os comentarios estão em EG, fiz o project sample para o PSC, talvez mais tarde eu traduza para PT
Depois de as classes colucadas, pequeno exemple de como utilizar:
Código:
Public Sub LoadSettings()
Dim oXML As New XML_FILE.cXML(XML_PATH)
g_Settings = New stSettings
g_Settings.Server = "192.168.200.179"
g_Settings.DataBase = "vip_blue"
g_Settings.UserName = "admin"
g_Settings.Password = "123"
For Each oItem As XML_FILE.cTag In oXML.GetAllSettings("Servidor").Values
Select Case oItem.Name
Case "Server"
g_Settings.Server = oItem.Value
Case "DataBase"
g_Settings.DataBase = oItem.Value
Case "UserName"
g_Settings.UserName = oItem.Value
Case "Password"
g_Settings.Password = oItem.Value
End Select
Next
g_frmMain.txtServer.Text = g_Settings.Server
g_frmMain.txtBaseDados.Text = g_Settings.DataBase
g_frmMain.txtUser.Text = g_Settings.UserName
g_frmMain.txtPassword.Text = g_Settings.Password
oXML = Nothing
End Sub
Public Sub SaveSettings()
Dim oXML As New XML_FILE.cXML(XML_PATH)
oXML.SaveSetting("Server", "Servidor", g_Settings.Server)
oXML.SaveSetting("Server", "DataBase", g_Settings.DataBase)
oXML.SaveSetting("Server", "UserName", g_Settings.UserName)
oXML.SaveSetting("Server", "Password", g_Settings.Password)
oXML = Nothing
End Sub
Código:
<?xml version="1.0" encoding="UTF-8"?>
<fLaSh>
<Section Name="Server">
<Key Name="Servidor" Value="192.168.200.179" />
<Key Name="DataBase" Value="vip_blue" />
<Key Name="UserName" Value="admin" />
<Key Name="Password" Value="hfghrty45yfg" />
</Section>
<Section Name="GUI">
<Key Name="Intervalo" Value="30" />
<Key Name="Data" Value="15-10-2008" />
<Key Name="Hash" Value="sdfsdfldfsdgdgfsdfsdfsdfsdfsdfsdf" />
<Key Name="ID" Value="995959595" />
</Section>
</fLaSh>
Código:
'Copyright: fLaSh - Carlos.DF
'http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=6795&lngWId=10
Imports System.Xml
Namespace XML_FILE
Public Class cXML
Private m_strFilePath As String
Private m_strRootName As String
Private m_crSectionSeparator As Char
Private m_objXMLDoc As XmlDocument
Public Sub New(ByVal sPath As String, _
Optional ByVal sRootName As String = "VIP_Blue", _
Optional ByVal cSectionSeparator As Char = ";")
m_strFilePath = sPath.Trim
m_strRootName = sRootName.Trim
m_crSectionSeparator = cSectionSeparator
Me.OpenFile()
End Sub
Protected Overrides Sub Finalize()
m_objXMLDoc = Nothing
MyBase.Finalize()
End Sub
Private Sub OpenFile()
'------------------------------------------------------------------
'Purpose: Opens XML settings file
'
'------------------------------------------------------------------
Try
If IO.File.Exists(m_strFilePath) Then
Dim oTR As New XmlTextReader(m_strFilePath)
m_objXMLDoc = New XmlDocument
m_objXMLDoc.Load(oTR)
oTR.Close()
oTR = Nothing
End If
Catch e As XmlException
Debug.WriteLine("Settings Constructor Error: " & e.ToString)
End Try
If m_objXMLDoc Is Nothing Then
m_objXMLDoc = New XmlDocument
m_objXMLDoc.LoadXml( _
"<?xml version=""1.0"" encoding=""UTF-8""?>" & ControlChars.CrLf & _
"<" & m_strRootName & ">" & ControlChars.CrLf & "</" & m_strRootName & ">")
End If
End Sub
Public Property FilePath() As String
'------------------------------------------------------------------
'Purpose: Gets or sets the value of the XMLSettings file name
'
'------------------------------------------------------------------
Get
Return m_strFilePath
End Get
Set(ByVal Value As String)
m_strFilePath = Value.Trim
End Set
End Property
Public Property RootName() As String
'------------------------------------------------------------------
'Purpose: Gets or sets the value of the XMLSettings section
'
'------------------------------------------------------------------
Get
Return m_strRootName
End Get
Set(ByVal Value As String)
m_strRootName = Value.Trim
End Set
End Property
Public Property SectionSeparator() As Char
'------------------------------------------------------------------
'Purpose: Gets or sets the value for extentions parameters..
'
'------------------------------------------------------------------
Get
Return m_crSectionSeparator
End Get
Set(ByVal Value As Char)
m_crSectionSeparator = Value
End Set
End Property
Friend Function GetAllSections() As Hashtable
'------------------------------------------------------------------
'Purpose: Retrieves section names from XML Settings file
'
'
'Returns: Collection of Strings containing the all the
' section names in the XML File
'------------------------------------------------------------------
Dim colSections As New Hashtable
Dim oNodeList As XmlNodeList
Dim oNode As XmlNode
oNodeList = m_objXMLDoc.SelectNodes("//Section")
If Not oNodeList Is Nothing Then
For Each oNode In oNodeList
colSections.Add(oNode.Attributes("Name").Value, oNode)
Next
End If
oNodeList = Nothing
oNode = Nothing
Return colSections
End Function
Friend Function GetAllSettings(ByVal sSections As String) As Hashtable
'------------------------------------------------------------------
'Purpose: Retrieves section names from XML Settings file
'
'Params: sSections: the sections to get (for multpiples sections
' is separated by m_crSectionSeparator)
'
'Returns: Collection of Strings containing the all the
' section names in the XML File
'------------------------------------------------------------------
Dim colSetting As New Hashtable
Dim oItem As cTag
Dim oNode As XmlNode
Dim oKey As XmlNode
Dim oNodeList As XmlNodeList
Dim arrSections() As String
If InStr(sSections, m_crSectionSeparator) Then
arrSections = Split(sSections, m_crSectionSeparator)
Else
ReDim arrSections(0)
arrSections(0) = sSections
End If
For Each strSection As String In arrSections
oNode = m_objXMLDoc.SelectSingleNode("//Section[@Name='" & strSection & "']")
If oNode IsNot Nothing Then
oNodeList = oNode.SelectNodes("descendant::Key")
If oNodeList IsNot Nothing Then
For Each oKey In oNodeList
oItem = New cTag
oItem.Name = oKey.Attributes("Name").Value
oItem.Value = oKey.Attributes("Value").Value
oItem.Key = strSection
'Add item to collection
colSetting.Add(oKey.Attributes("Name").Value, oItem)
Next
End If
End If
Next
oNodeList = Nothing
oKey = Nothing
Return colSetting
End Function
Friend Function GetSetting(ByVal sSection As String, ByVal sKey As String) As String
'------------------------------------------------------------------
'Purpose: Retrieves section names from XML Settings file
'
'
'Returns: Collection of Strings containing the all the
' section names in the XML File
'------------------------------------------------------------------
Dim sValue As String = String.Empty
Dim oSection As XmlNode
Dim oKey As XmlNode
oSection = m_objXMLDoc.SelectSingleNode("//Section[@Name='" & sSection & "']")
If oSection IsNot Nothing Then
oKey = oSection.SelectSingleNode("descendant::Key[@Name='" & sKey & "']")
If oKey IsNot Nothing Then
sValue = oKey.Attributes("Value").Value
End If
End If
oSection = Nothing
oKey = Nothing
Return sValue
End Function
Friend Sub SaveSetting(ByVal sSection As String, ByVal sKeyName As String, ByVal sValue As String)
'------------------------------------------------------------------
'Purpose: Retrieves handle creation or updating of Section/Key pairs
'
'
'Params: sKeyName: The section names in the XML File
' sSection: The name of the XML section
' vValue: The value to set (saved to string)
'------------------------------------------------------------------
Dim oSection As XmlNode
Dim oKey As XmlNode
Dim oAttr As XmlAttribute
'Check the document exists, create if not
If m_objXMLDoc.DocumentElement Is Nothing Then
m_objXMLDoc.LoadXml("<?xml version=""1.0"" encoding=""UTF-8""?>" & ControlChars.CrLf & _
"<" & m_strRootName & ">" & ControlChars.CrLf & "</" & m_strRootName & ">")
End If
oSection = m_objXMLDoc.SelectSingleNode("//Section[@Name='" & sSection & "']")
'Check the Section exists, create if not
If oSection Is Nothing Then
Try
'Create the new Section node...
oSection = m_objXMLDoc.CreateNode(XmlNodeType.Element, "Section", "")
'Add the Name attribute
oAttr = m_objXMLDoc.CreateAttribute("Name")
oAttr.Value = sSection
oSection.Attributes.SetNamedItem(oAttr)
'Get the root XML node and add the new node to the document
Dim xnRoot As XmlNode = m_objXMLDoc.DocumentElement
xnRoot.AppendChild(oSection)
xnRoot = Nothing
Catch e1 As XmlException
Debug.WriteLine("SaveSetting - Error creating Section: " & e1.ToString)
End Try
End If
oKey = oSection.SelectSingleNode("descendant::Key[@Name='" & sKeyName & "']")
'Check the Key exists, create if not
If oKey Is Nothing Then
Try
'Create the new Key node...
oKey = m_objXMLDoc.CreateNode(XmlNodeType.Element, "Key", "")
'Add the Name attribute
oAttr = m_objXMLDoc.CreateAttribute("Name")
oAttr.Value = sKeyName
oKey.Attributes.SetNamedItem(oAttr)
'Add the Value attribute
oAttr = m_objXMLDoc.CreateAttribute("Value")
oAttr.Value = sValue
oKey.Attributes.SetNamedItem(oAttr)
'Add the new node to its Section
oSection.AppendChild(oKey)
Catch e2 As XmlException
Debug.WriteLine("SaveSetting - Error creating Key: " & e2.ToString)
End Try
Else
oKey.Attributes("Value").Value = sValue
End If
'Save changes
m_objXMLDoc.Save(m_strFilePath)
oKey = Nothing
oSection = Nothing
End Sub
Friend Sub DeleteKey(ByVal sSection As String, ByVal sKeyName As String)
'------------------------------------------------------------------
'Purpose: Deletes the specified key, deleting with
' empty KeyName deletes the specified section
'
'Params:
' sSection: The name of the XML section
' sKeyName: The name of the Key
'------------------------------------------------------------------
Dim oSection As XmlNode
Dim oKey As XmlNode
oSection = m_objXMLDoc.SelectSingleNode("//Section[@Name='" & sSection & "']")
If oSection IsNot Nothing Then
'delete the key
oKey = oSection.SelectSingleNode("descendant::Key[@Name='" & sKeyName & "']")
If oKey IsNot Nothing Then
oSection.RemoveChild(oKey)
Else
Exit Sub
End If
End If
m_objXMLDoc.Save(m_strFilePath)
oKey = Nothing
oSection = Nothing
End Sub
Friend Sub DeleteSection(ByVal sSection As String)
'------------------------------------------------------------------
'Purpose: Deletes the specified section, deleting with
' empty KeyName deletes the specified section
'
'Params:
' sSection: The name of the XML section
'------------------------------------------------------------------
Dim oSection As XmlNode
Dim oKey As XmlNode
oSection = m_objXMLDoc.SelectSingleNode("//Section[@Name='" & sSection & "']")
If oSection IsNot Nothing Then
'Delete the section
Dim oRoot As XmlNode = m_objXMLDoc.DocumentElement
oRoot.RemoveChild(oSection)
End If
m_objXMLDoc.Save(m_strFilePath)
oKey = Nothing
oSection = Nothing
End Sub
End Class
Public Class cTag
Private m_lngID As Long
Private m_strName As String
Private m_strKey As String
Private m_strValue As String
Private m_objTag As Object
Private m_dtIniDate As Date
Public Sub New()
m_dtIniDate = Now
End Sub
Friend Property ID() As Long
Get
Return m_lngID
End Get
Set(ByVal value As Long)
m_lngID = value
End Set
End Property
Friend Property Name() As String
Get
Return m_strName
End Get
Set(ByVal value As String)
m_strName = value
End Set
End Property
Friend Property Key() As String
Get
Return m_strKey
End Get
Set(ByVal value As String)
m_strKey = value
End Set
End Property
Friend Property Tag() As Object
Get
Return m_objTag
End Get
Set(ByVal value As Object)
m_objTag = value
End Set
End Property
Friend Property Value() As String
Get
Return m_strValue
End Get
Set(ByVal value As String)
m_strValue = value
End Set
End Property
Friend ReadOnly Property [Date]() As Date
Get
Return m_dtIniDate
End Get
End Property
End Class
End Namespace
Última edição:
