急寻xml操作模块,请高手多多指点.

[ryan211]

我要写一个小软件,里面用到xml.
但是发现网上的VB操作xml资料太少了.
希望牛人贴一个模块出来.
包括

打开xml
新建xml
读取指定节点
读取某节点下所有内容
设置节点属性
删除指定节点.

[ryan211]

为了节省大虾时间,我贴一上模块上来.
请大虾修改一下,让他更合理.
功能更全面.谢谢
我要急用啊,谢谢了





Option Explicit
Private xml_document As DOMDocument
Private values_node As IXMLDOMNode
Private p_AppPath, FileName, TopTag, XmlStr As String
Private IsOpen As Boolean

'****************************
'Init 模块初始化 ok
'****************************
Public Function Init()
p_AppPath = App.Path
FileName = "\group.xml"
TopTag = "UserList"
Set xml_document = New DOMDocument
End Function

'*****************************
'LoadFiles 载入现有文件 ok
'*****************************
Public Function LoadFiles()

xml_document.Load p_AppPath & FileName
If xml_document.documentElement Is Nothing Then
Exit Function
End If
Set values_node = xml_document.documentElement
IsOpen = True

End Function

'****************************
'NewXmlDoc 建立新的xml文档
'同时设置顶层节点TopTag
'****************************
Public Function NewXmlDoc()
XmlStr = "<?xml version=""1.0"" encoding=""gb2312""?><" & TopTag & "></" & TopTag & ">"
xml_document.loadXML XmlStr
Set values_node = xml_document.documentElement
' 建立XML文件
If values_node Is Nothing Then
Exit Function
End If

'Set values_node = xml_document.createElement(TopTag)
'xml_document.appendChild values_node
IsOpen = True

End Function

'*************************************
'GetNodeValue 返回各个节点的值
'start_at_node 父节点名称
'node_name 子节点名称
'default_value 默认节点值
'*************************************
Public Function GetNodeValue(ByVal start_at_node As String, ByVal node_name As String, ByVal default_value As String) As String
Dim search_node As IXMLDOMNode
Dim Obj_Node As IXMLDOMNode
If IsOpen = False Then Exit Function
Set search_node = values_node.selectSingleNode(start_at_node)
Set Obj_Node = search_node.selectSingleNode(node_name)
If Obj_Node Is Nothing Then
GetNodeValue = default_value
Else
GetNodeValue = Obj_Node.Text
End If

End Function

'***************************
' SaveFiles 保存xml文档 ok
'***************************
Public Function SaveFiles()
xml_document.save p_AppPath & FileName
End Function

'***************************************************
'CreateNode新建节点 ok
'parent 父节点名称
'node_name 子节点名称
'node_value 为空建立子节点,并把节点对象设置为新建的节点.
'***************************************************
Public Sub CreateNode(ByVal Parent As String, ByVal node_name As String, ByVal node_value As String)
Dim new_node As IXMLDOMNode
Dim Parent_Node As IXMLDOMNode

If IsOpen = False Then Exit Sub
Set Parent_Node = values_node.selectSingleNode(Parent)

If Trim(node_value) <> "" Then
Set new_node = Parent_Node.ownerDocument.createElement(node_name)
new_node.Text = node_value
Parent_Node.appendChild new_node

Else
Set new_node = Parent_Node.ownerDocument.createElement(node_name)
new_node.Text = node_value
Parent_Node.appendChild new_node
Set values_node = values_node.selectSingleNode(node_name)
End If

End Sub

'********************************
'DeleteNode 删除节点
'********************************
Public Sub DeleteNode(ByVal Parent As String, ByVal Obj_Node As String)

Dim Dele_Node As IXMLDOMElement
Dim Parent_Node As IXMLDOMElement

If IsOpen = False Then Exit Sub
Set Parent_Node = values_node.selectSingleNode(Parent)

Set Dele_Node = Parent_Node.selectSingleNode(Obj_Node)
If Dele_Node Is Nothing Then
Exit Sub
Else
Parent_Node.removeChild Dele_Node
End If

End Sub

'********************************
'SetAttr 设置节点属性
'Obj_Node 节点名称
'AttrName 节点属性名称
'AttrValue 节点属性值
'*******************************
Public Sub SetAttr(ByVal Obj_Node As String, ByVal AttrName As String, ByVal AttrValue As String)
Dim Attr_Node As IXMLDOMElement
Dim Parent_Node As IXMLDOMElement

If IsOpen = False Then Exit Sub
Set Parent_Node = values_node.selectSingleNode(Obj_Node)
Set Attr_Node = Parent_Node
Attr_Node.setAttribute AttrName, AttrValue
End Sub

'*****************************
'EditNodeValue 修改节点值
'EditName 节点名称
'NewValue 节点新值
'*****************************
Public Sub EditNodeValue(ByVal EditName As String, ByVal NewValue As String)
Dim Edit_Node As IXMLDOMElement
Set Edit_Node = values_node.selectSingleNode(EditName)
If Edit_Node Is Nothing Then
MsgBox "not found"
Exit Sub
Else
Edit_Node.Text = NewValue
End If

End Sub

[ryan211]

要能返回某节点下的,所有节点值.
<aaa>
<abc>123</abc>
<abc>456</abc>
<abc>789</abc>
</aaa>

读取所有aaa节点下,abc节点的值

[xiaoyaolz]

我做过这种东东,用着还行,要分解重来不想动手了