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