clsxml.cls

vb编制的木马加花器

xNode.setAttribute strName, Value

Set xNode = Nothing

Exit Function
ErrHandle:
Set xNode = Nothing
End Function
'---------------------------------------------------
' Function
'   NodeCount
' Parameters
'   strQuery As String : The query used to access the
'       nodes
' What it does
'   Returns the count of the nodes
'
' Author
'   Anthony (11.18.02)
' Modified
'   (11.22.02)
' Fixed
'   - Returns the correct node count now
'     instead of just 1
'---------------------------------------------------
Public Function NodeCount(strQuery As String) As Long
On Error GoTo ErrHandle:

Dim xNode As MSXML.IXMLDOMNode
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)

NodeCount = xNode.childNodes.Length

Set xNode = Nothing

Exit Function
ErrHandle:
NodeCount = -1
Set xNode = Nothing
End Function
'---------------------------------------------------
' Function
'   Save
' Parameters
'   strFileName As String : Full path to the save
'       destination
' What it does
'   Saves the XML file to strFileName
' Author
'   Anthony (11.18.02)
' Modified
'   (11.18.02)
'---------------------------------------------------
Public Function Save(strFileName As String)
xDoc.Save strFileName
End Function
'---------------------------------------------------
' Function
'   DeleteNode
' Parameters
'   strQuery As String : Query to find the node
' What it does
'   Deletes a child node specified by strQuery
' Author
'   Anthony (11.18.02)
' Modified
'   (11.18.02)
'---------------------------------------------------
Public Function DeleteNode(strQuery As String)
On Error GoTo ErrHandle:

Dim xNode As MSXML.IXMLDOMNode
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)

xNode.parentNode.removeChild xNode

Set xNode = Nothing

Exit Function
ErrHandle:
Set xNode = Nothing
End Function
'---------------------------------------------------
' Function
'   MakeNode
' Parameters
'   strQuery As String : Query to find the parent
'       node
'   strName As String : Name of the new node
'   Optional Value As Variant : Value of the node
' What it does
'   Creates a new node in the XML file
' Author
'   Anthony (11.18.02)
' Modified
'   (11.19.02)
'---------------------------------------------------
Public Function MakeNode(strQuery As String, strName As String, Optional Value As Variant, Optional strAttributeName1 As String, Optional AttributeValue1 As Variant, Optional strAttributeName2 As String, Optional AttributeValue2 As Variant)
Dim xPNode As MSXML.IXMLDOMNode
Dim xCNode As MSXML.IXMLDOMElement
Set xPNode = xDoc.documentElement.selectSingleNode(strQuery)
Set xCNode = xDoc.createElement(strName)

If Not IsMissing(Value) Then
    xCNode.Text = Value
End If

xPNode.appendChild xCNode

If Not IsMissing(strAttributeName1) Then
    WriteAttribute strQuery & "/" & xCNode.nodeName, strAttributeName1, AttributeValue1
End If

If Not IsMissing(strAttributeName2) Then
    WriteAttribute strQuery & "/" & xCNode.nodeName, strAttributeName2, AttributeValue2
End If
End Function
'---------------------------------------------------
' Function
'   DeleteAttribute
' Parameters
'   strQuery As String : Query to find the parent
'       node
'   strName As String : Name of the attribute to be
'       deleted
' What it does
'   Deletes strAttributeName from the node specified
'   by strQuery
' Author
'   Anthony (11.19.02)
' Modified
'   (11.19.02)
'---------------------------------------------------
Public Function DeleteAttribute(strQuery As String, strAttributeName As String)
Dim xNode As MSXML.IXMLDOMElement
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)

xNode.Attributes.removeNamedItem strAttributeName

Set xNode = Nothing
End Function

'---------------------------------------------------
' Function
'   GetColorValue
' Parameters
'   strQuery : Query used to locate the (x, x, x) node
' What it does
'   Parses a node found in the format (x, x, x) to be
'   used as an rgb value
'   Set the object to be colored equal to this
'   EX: frmMain.BackColor = XML.GetColorValue("query")
' Author
'   Anthony (11.20.02)
' Modified
'   (11.20.02)
'---------------------------------------------------
Public Function GetColorValue(strQuery As String) As Long
Dim xNode As MSXML.IXMLDOMNode
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)

Dim Red As Integer, Green As Integer, Blue As Integer
Dim Data() As String

Data = Split(xNode.Text, ", ")

Red = Val(Right(Data(0), Len(Data(0)) - 1))
Green = Val(Data(1))
Blue = Val(Left(Data(2), Len(Data(2)) - 1))

GetColorValue = RGB(Red, Green, Blue)
End Function
'---------------------------------------------------
' Function
'   SetColorValue
' Parameters
'   strQuery : Query used to locate the (x, x, x) node
'   Red : Red color value
'   Green : Green color value
'   Blue : Blue color value
' What it does
'   Writes the color data with format (Red, Green, Blue)
'   To a specified node, allowing for easy skinning
' Author
'   Anthony (11.20.02)
' Modified
'   (11.20.02)
'---------------------------------------------------
Public Function SetColorValue(strQuery As String, Red As Integer, Green As Integer, Blue As Integer)
Dim strData As String
strData = "(" & Red & ", " & Green & ", " & Blue & ")"

WriteNode strQuery, strData
End Function

'---------------------------------------------------
' Function
'   GetChildValue
' Parameters
'   strQuery : Query used to locate the parent node
'   Index : Count of the node (first = 1, etc...)
' What it does
'   Allows easy child access for parent nodes
'   (If multiple children exist under a parent)
'   Only returns the value of the node
'   Other functions are used to get to
'   Attributes of Child Nodes
'
'   Also allows for loading of XML files where the
'   tags or tag count is not known
' Author
'   Anthony (11.22.02)
' Modified
'   (11.22.02)
'---------------------------------------------------
Public Function GetChildValue(strQuery As String, Index As Long) As String
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNode
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)

GetChildValue = xNode.childNodes(Index).Text

Set xNode = Nothing

Exit Function
ErrHandle:
GetChildValue = ""
Set xNode = Nothing
End Function
'---------------------------------------------------
' Function
'   GetChildAttribute
' Parameters
'   strQuery : Query used to locate the parent node
'   strName : Name of the attribute to read
'   Index : Count of the node (first = 1, etc...)
' What it does
'   Allows you to access the attribute of a child
'   node easily
' Author
'   Anthony (11.22.02)
' Modified
'   (11.22.02)
'---------------------------------------------------
Public Function GetChildAttribute(strQuery As String, strName As String, Index As Long) As String
On Error GoTo ErrHandle:
Dim xNode As MSXML.IXMLDOMNode
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)
GetChildAttribute = xNode.childNodes(Index).Attributes.getNamedItem(strName).Text
Set xNode = Nothing
Exit Function
ErrHandle:
GetChildAttribute = ""
Set xNode = Nothing
End Function
'---------------------------------------------------
' Function
'   GetChildName
' Parameters
'   strQuery : Query used to locate the parent node
'   Index : Count of the node (first = 1, etc...)
' What it does
'   Returns the name of the node
'   EX: <hello> (name: hello)
' Author
'   Anthony (11.23.02)
' Modified
'   (11.23.02)
'---------------------------------------------------
Public Function GetChildName(strQuery As String, Index As Long) As String
Dim xNode As MSXML.IXMLDOMNode
Set xNode = xDoc.documentElement.selectSingleNode(strQuery)

GetChildName = xNode.childNodes(Index).nodeName

Set xNode = Nothing
End Function