XML完整操作模块

Option Explicit

Private XML_Dom As FreeThreadedDOMDocument40


'--------------------------------------------------------------------------------
' 工程: Prj_Rpt
' 程序: CreateNode
' 描述: 建立一个XML节点，返回建立好的节点对象
' 设计: Winahriman
' 时间: 1-26-2008-13:1:40
'
' 参数: NodeName (String) 需要建立的节点的名字
' Name() (Variant) 可变参数，参数定义（如果传入只传入一个参数，表示该节点只有值没有属性值）
' 如果传入的双数参数表示该节点只有属性及属性值，没有节点值，如果传入的是大于1的单数参数
' 则表示即有属性及属性值也同时有节点值，属性及属性值的参数表示是，每2个参数的第一个参数为属性名
' 第二个参数为属性值
'--------------------------------------------------------------------------------

Public Function CreateNode(ByVal NodeName As String, ParamArray Name() As Variant) As IXMLDOMNode

Dim Int_I As Integer

Dim XML_NewNode As IXMLDOMNode

Set XML_Dom = New FreeThreadedDOMDocument40

Set XML_NewNode = XML_Dom.CreateNode(1, NodeName, "") '建立一个节点

If UBound(Name) = -1 Then '没有可变参数

Else
Dim Xml_AttNode As IXMLDOMNode '节点属性设置
If UBound(Name) Mod 2 <> 0 Then '如果可变参数数目和2取模不等于0，表示只有属性和属性值，没有节点值
For Int_I = LBound(Name) To UBound(Name) Step 2 '循环可变参数数组
Set Xml_AttNode = XML_Dom.CreateNode(2, Name(Int_I), "") '加入一个属性名
Xml_AttNode.Text = Name(Int_I + 1) '加入以个属性值
XML_NewNode.Attributes.setNamedItem Xml_AttNode '将节点属性加入对应节点
Next
Else
If UBound(Name) <> 0 Then
For Int_I = LBound(Name) To UBound(Name) - 1 Step 2 '循环可变参数数组
Set Xml_AttNode = XML_Dom.CreateNode(2, Name(Int_I), "") '加入一个属性名
Xml_AttNode.Text = Name(Int_I + 1) '加入以个属性值
XML_NewNode.Attributes.setNamedItem Xml_AttNode '将节点属性加入对应节点
Next
End If

Dim XML_CDATA As IXMLDOMCDATASection
Set XML_CDATA = XML_Dom.createCDATASection(Name(UBound(Name))) '建立CDATA值
XML_NewNode.appendChild XML_CDATA

End If
End If

Set XML_Dom = Nothing

Set CreateNode = XML_NewNode
End Function


'--------------------------------------------------------------------------------
' 工程: Prj_Rpt
' 程序: LoadXmlNode
' 描述: 加载一个XML文档，返回文档主节点（因为在XML文档中只允许有一个主节点，同时还包括以个文件头）
' 设计: Winahriman
' 时间: 1-28-2008-09:00:55
'
' 参数: Xml_File (String) 'XML文档路径
'--------------------------------------------------------------------------------
Public Function LoadXmlNode(ByVal Xml_File As String) As IXMLDOMNode
Dim Xml_FaterNode As IXMLDOMNode

Set XML_Dom = New FreeThreadedDOMDocument40

If XML_Dom.Load(Xml_File) = False Then Exit Function

Set LoadXmlNode = XML_Dom.childNodes(1)

Set XML_Dom = Nothing

End Function


'--------------------------------------------------------------------------------
' 工程: Prj_Rpt
' 程序: DeleteNode
' 描述: 移除一个主节点，同时返回移除后的节点对象
' 设计: Winahriman
' 时间: 1-28-2008-09:07:14
'
' 参数: Xml_FatherNode (IXMLDOMNode) 需要移除节点的父域节点对象
' DeleteNodeName (String) 需要移除的节点名
'--------------------------------------------------------------------------------
Public Function DeleteNode(ByVal Xml_FatherNode As IXMLDOMNode, ByVal DeleteNodeName As String) As IXMLDOMNode
Dim Xml_FindNode As IXMLDOMNode

Set Xml_FindNode = Xml_FatherNode.selectSingleNode(DeleteNodeName)

Xml_FatherNode.removeChild Xml_FindNode

Set DeleteNode = Xml_FatherNode
End Function


'--------------------------------------------------------------------------------
' 工程: Prj_Rpt
' 程序: ScreenSencetionValue
' 描述: 查询一个节点或节点值，其中第三个参数为可选参数，返回真假
' 设计: Winahriman
' 时间: 1-26-2008-15:08:57
'
' 参数: Xml_Node (IXMLDOMNode) 传入父域节点对象
' ScreenQualification (String) 需要查询的子节点的字符串（如果该节点具有属性值，并且要按其属性值进行查询那么输入格式为/子节点名[@属性名='属性值']）
' 这写个例子：比如一个XML节点为：<test><key name="Delete">xxxx</key></test>我们需要查找节点<key name="Delete">xxxx</key>
' 那么我们传入该函数的xml_node是节点<test>,我们的查询子节点字符串的写法就是"/key[@name='Delete']"这样就会找到该节点
' Value (String = "") 可选参数，如果传入该参数则将会返回查询到的节点的值，如果不传入该参数，则该函数仅作为节点是否存在的查询
'--------------------------------------------------------------------------------
Public Function ScreenSencetionValue(ByVal Xml_Node As IXMLDOMNode, ByVal ScreenQualification As String, Optional ByRef Value As String = "") As Boolean
Dim Xml_FindNode As IXMLDOMNode
Value = ""
Set Xml_FindNode = Xml_Node.selectSingleNode(ScreenQualification)
If Xml_FindNode Is Nothing Then
Exit Function
End If
Value = Xml_FindNode.Text
ScreenSencetionValue = True
End Function


'--------------------------------------------------------------------------------
' 工程: Prj_Rpt
' 程序: SencetionLens
' 描述: 查询一个节点的长度（也就是需要查询的节点的子节点个数）
' 设计: Winahriman
' 时间: 1-27-2008-09:17:21
'
' 参数: Xml_Node (IXMLDOMNode) 需要查询的节点对象
' ScreenQualification (String) 查询的字符串使用方式和查询节点相同
'--------------------------------------------------------------------------------
Public Function SencetionLens(ByVal Xml_Node As IXMLDOMNode, ByVal ScreenQualification As String) As Long
Dim Xml_FindNode As IXMLDOMNode

Set Xml_FindNode = Xml_Node.selectSingleNode(ScreenQualification)
If Xml_FindNode Is Nothing Then
Exit Function
End If

SencetionLens = Xml_FindNode.childNodes.length

End Function


'--------------------------------------------------------------------------------
' 工程: Prj_Rpt
' 程序: EditSencetionValue
' 描述: 修改节点值 返回真假
' 设计: Winahriman
' 时间: 1-27-2008-11:18:43
'
' 参数: Xml_Node (IXMLDOMNode) 需要修改节点值的父域节点，引用传递
' ScreenQualification (String) 查询字符串，使用方式和节点查询相同
' Value (String) 修改的字符串
'--------------------------------------------------------------------------------
Public Function EditSencetionValue(ByRef Xml_Node As IXMLDOMNode, ByVal ScreenQualification As String, ByVal Value As String) As Boolean
Dim Xml_FindNode As IXMLDOMNode

Set Xml_FindNode = Xml_Node.selectSingleNode(ScreenQualification)
If Xml_FindNode Is Nothing Then
Exit Function
End If
Xml_FindNode.Text = ""
Dim XML_CDATA As IXMLDOMCDATASection

Set XML_Dom = New FreeThreadedDOMDocument40

Set XML_CDATA = XML_Dom.createCDATASection(Value)

Xml_FindNode.appendChild XML_CDATA

Set XML_Dom = Nothing

EditSencetionValue = True

End Function


'--------------------------------------------------------------------------------
' 工程: Prj_Rpt
' 程序: CreateXMLFile
' 描述: 创建一个XML文档
' 设计: Winahriman
' 时间: 1-28-2008-09:20:22
'
' 参数: FileName (String) 文件路径名
' Xml_Node (IXMLDOMNode) XML主节点
'--------------------------------------------------------------------------------
Public Function CreateXMLFile(ByVal FileName As String, ByVal Xml_Node As IXMLDOMNode) As Boolean
Dim Pi As IXMLDOMProcessingInstruction '申明一个版本头

Set XML_Dom = New FreeThreadedDOMDocument40

Set Pi = XML_Dom.createProcessingInstruction("xml", "version=""1.0"" encoding=""gb2312""") '建立一个版本头对象
XML_Dom.insertBefore Pi, XML_Dom.childNodes.Item(0) '插入版本头
XML_Dom.appendChild Xml_Node '建立一个主节点 '保存新的XML文件
XML_Dom.Save FileName

Set XML_Dom = Nothing
End Function