如有一xml文件(myTest.xml)如下:
<?xml version="1.0" encoding="utf-8"?>
<Root>
<Profile Code="001" Name="myx" City="gz" />
<Profile Code="002" Name="myName" City="bj" />
</Root>
<Root>
<Profile Code="001" Name="myx" City="gz" />
<Profile Code="002" Name="myName" City="bj" />
</Root>
一、添加
现在要在Root下加节点Profile
Function Create(ByVal strCode As String, ByVal strName As String, ByVal strCity As String) As Boolean
Try
Dim xmlDoc As XmlDocument = New XmlDocument
xmlDoc.Load("myTest.xml")
Dim NodeList As XmlNodeList = xmlDoc.SelectSingleNode("//Root").ChildNodes
'下面是查Code是否唯一 '后有自动增加Code的值的代码.
For Each xn As XmlNode In NodeList
Dim myxe As XmlElement = xn '转换类型
If myxe.GetAttribute("Code") = Filtrate(strCode) Then
Return False
Exit Function
End If
Next
Dim root As XmlNode = xmlDoc.SelectSingleNode("Root") '查找<Root>
Dim xe As XmlElement = xmlDoc.CreateElement("Profile") '创建一个<Profile>节点
xe.SetAttribute("Code", Filtrate(strCode)) '设置该节点Code属性
xe.SetAttribute("Name", Filtrate(strName)) '设置该节点的Name属性
xe.SetAttribute("City", Filtrate(strCity)) '设置该节点的City属性
'以下是在<Profile>下建子节点<"myTest">
'XmlElement xesub1=xmlDoc.CreateElement("myTest");
'xesub1.InnerText="myText"; '设置文本节点
'xe1.AppendChild(xesub1); '添加到<Root>节点中
root.AppendChild(xe) '添加到<Root>节点中
xmlDoc.Save("myTest.xml")
Return True
Catch ex As Exception
Return False
End Try
End Function
Try
Dim xmlDoc As XmlDocument = New XmlDocument
xmlDoc.Load("myTest.xml")
Dim NodeList As XmlNodeList = xmlDoc.SelectSingleNode("//Root").ChildNodes
'下面是查Code是否唯一 '后有自动增加Code的值的代码.
For Each xn As XmlNode In NodeList
Dim myxe As XmlElement = xn '转换类型
If myxe.GetAttribute("Code") = Filtrate(strCode) Then
Return False
Exit Function
End If
Next
Dim root As XmlNode = xmlDoc.SelectSingleNode("Root") '查找<Root>
Dim xe As XmlElement = xmlDoc.CreateElement("Profile") '创建一个<Profile>节点
xe.SetAttribute("Code", Filtrate(strCode)) '设置该节点Code属性
xe.SetAttribute("Name", Filtrate(strName)) '设置该节点的Name属性
xe.SetAttribute("City", Filtrate(strCity)) '设置该节点的City属性
'以下是在<Profile>下建子节点<"myTest">
'XmlElement xesub1=xmlDoc.CreateElement("myTest");
'xesub1.InnerText="myText"; '设置文本节点
'xe1.AppendChild(xesub1); '添加到<Root>节点中
root.AppendChild(xe) '添加到<Root>节点中
xmlDoc.Save("myTest.xml")
Return True
Catch ex As Exception
Return False
End Try
End Function
这样加来结果是这样的:
<?xml version="1.0" encoding="utf-8"?>
<Root>
<Profile Code="001" Name="myx" City="gz" />
<Profile Code="002" Name="myName" City="bj" />
<Profile Code="003" Name="New Name" City="New City" /><!--新加的-->
</Root>
<Root>
<Profile Code="001" Name="myx" City="gz" />
<Profile Code="002" Name="myName" City="bj" />
<Profile Code="003" Name="New Name" City="New City" /><!--新加的-->
</Root>
二、显示所有数据
Function Retrieve() As DataSet
Try
Dim doc As XmlDocument = New XmlDocument
doc.Load("myTest.xml")
Dim node As XmlNode = doc.SelectSingleNode("//Root")
Dim read As StringReader = New StringReader(node.OuterXml)
Dim myds As DataSet = New DataSet
myds.ReadXml(read)
Return myds
If Not myds Is Nothing Then myds.Dispose()
Catch ex As Exception
' MsgBox(ex.Message)
End Try
End Function
三、搜索数据,读某一条数据也可以用这直接读。
Function Search(ByVal strKeyWord As String, ByVal strKeyText As String) As DataSet
Try
Dim doc As XmlDocument = New XmlDocument
doc.Load("myTest.xml")
Dim NodeList As XmlNodeList = doc.SelectSingleNode("//Root").ChildNodes
Dim i As Integer
Dim strXml As String = "<myx_Search>" '把搜索到的放在这里
For Each xn As XmlNode In NodeList
If strKeyText = "" Or strKeyText = "全部" Then '搜索所有的属性值
For i = 0 To xn.Attributes.Count - 1
Dim xe As XmlElement = xn '转换类型
If xe.GetAttribute(xn.Attributes(i).Name) = strKeyWord Then
strXml = strXml & xn.OuterXml
End If
Next
Else
Dim xe As XmlElement = xn '转换类型
If xe.GetAttribute(strKeyText) = strKeyWord Then '搜索指定的属性值
strXml = strXml & xn.OuterXml
End If
End If
Next
strXml = strXml & "</myx_Search>"
'MsgBox(strXml)
Dim read As StringReader = New StringReader(strXml)
Dim myds As DataSet = New DataSet
myds.ReadXml(read)
Return myds
If Not myds Is Nothing Then myds.Dispose()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Function
Try
Dim doc As XmlDocument = New XmlDocument
doc.Load("myTest.xml")
Dim NodeList As XmlNodeList = doc.SelectSingleNode("//Root").ChildNodes
Dim i As Integer
Dim strXml As String = "<myx_Search>" '把搜索到的放在这里
For Each xn As XmlNode In NodeList
If strKeyText = "" Or strKeyText = "全部" Then '搜索所有的属性值
For i = 0 To xn.Attributes.Count - 1
Dim xe As XmlElement = xn '转换类型
If xe.GetAttribute(xn.Attributes(i).Name) = strKeyWord Then
strXml = strXml & xn.OuterXml
End If
Next
Else
Dim xe As XmlElement = xn '转换类型
If xe.GetAttribute(strKeyText) = strKeyWord Then '搜索指定的属性值
strXml = strXml & xn.OuterXml
End If
End If
Next
strXml = strXml & "</myx_Search>"
'MsgBox(strXml)
Dim read As StringReader = New StringReader(strXml)
Dim myds As DataSet = New DataSet
myds.ReadXml(read)
Return myds
If Not myds Is Nothing Then myds.Dispose()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Function
四、修改
Public Function Update(ByVal strCode As String, ByVal strName As String, ByVal strCity As String) As Boolean
Try
Dim xmlDoc As New XmlDocument
xmlDoc.Load("myTest.xml")
Dim xnl As XmlNodeList = xmlDoc.SelectSingleNode("//Root").ChildNodes
For Each xn As XmlNode In xnl
Dim xe As XmlElement = xn '转换类型
If xe.GetAttribute("Code") = strCode Then
'xe.SetAttribute("Code", strCode) 'xe.InnerText=""
xe.SetAttribute("Name", strName)
xe.SetAttribute("City", strCity)
End If
Next
xmlDoc.Save("myTest.xml")
Return True
Catch ex As Exception
Return False
End Try
End Function
Try
Dim xmlDoc As New XmlDocument
xmlDoc.Load("myTest.xml")
Dim xnl As XmlNodeList = xmlDoc.SelectSingleNode("//Root").ChildNodes
For Each xn As XmlNode In xnl
Dim xe As XmlElement = xn '转换类型
If xe.GetAttribute("Code") = strCode Then
'xe.SetAttribute("Code", strCode) 'xe.InnerText=""
xe.SetAttribute("Name", strName)
xe.SetAttribute("City", strCity)
End If
Next
xmlDoc.Save("myTest.xml")
Return True
Catch ex As Exception
Return False
End Try
End Function
五、删除
Function Delete(ByVal strCode As String) As Boolean
Try
Dim xmlDoc As New XmlDocument
xmlDoc.Load("myTest.xml")
Dim sxn As XmlNode = xmlDoc.DocumentElement.S _
electSingleNode("//Root/Profile[@Code=" & strCode & "]")
xmlDoc.SelectSingleNode("//Root").RemoveChild(sxn)
'Dim xn As XmlNode = xmlDoc.SelectSingleNode("//ProFile/Vendor[@Code=" & strCode & "]")
''For Each xn As XmlNode In xnl
'' Dim xe As XmlElement = xn
'' If xe.GetAttribute("Code") = strCode Then
'' ' xe.RemoveAll() '删除该节点的全部内容
'' ' xe.RemoveAttribute("Name") 删除Name属性
'' End If
''Next
xmlDoc.Save("myTest.xml")
Return True
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
End Function
Try
Dim xmlDoc As New XmlDocument
xmlDoc.Load("myTest.xml")
Dim sxn As XmlNode = xmlDoc.DocumentElement.S _
electSingleNode("//Root/Profile[@Code=" & strCode & "]")
xmlDoc.SelectSingleNode("//Root").RemoveChild(sxn)
'Dim xn As XmlNode = xmlDoc.SelectSingleNode("//ProFile/Vendor[@Code=" & strCode & "]")
''For Each xn As XmlNode In xnl
'' Dim xe As XmlElement = xn
'' If xe.GetAttribute("Code") = strCode Then
'' ' xe.RemoveAll() '删除该节点的全部内容
'' ' xe.RemoveAttribute("Name") 删除Name属性
'' End If
''Next
xmlDoc.Save("myTest.xml")
Return True
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
End Function
过滤:
Private Function Filtrate(ByVal InnerText As String) As String
InnerText = InnerText.Replace("&", "&")
InnerText = InnerText.Replace("<", "<") '用半角变全角,或用<>这样的
InnerText = InnerText.Replace(">", ">")
InnerText = InnerText.Replace("""", "")
Return InnerText
End Function
InnerText = InnerText.Replace("&", "&")
InnerText = InnerText.Replace("<", "<") '用半角变全角,或用<>这样的
InnerText = InnerText.Replace(">", ">")
InnerText = InnerText.Replace("""", "")
Return InnerText
End Function