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
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