cdomfunctions.cls

用XML做专家系统的一个编译器,有说明书,使用简单,有模板

        Case NODE_DOCUMENT_TYPE:
            Set elNode = oDOM.createNode(0, sEntity, "")
            oDOM.doctype.entities.SetNamedItem elNode
            AddEntity = True
        Case Else
            AddEntity = False
            Call SetErrorInfo(-1, "Invalid parent node type.", "CDomFunctions.AddEntity", HIERARCHY_REQUEST_ERR)
    
    End Select

ErrHand:
    If Err.Number <> 0 Then
    AddEntity = False
        Call SetErrorInfo(Err.Number, Err.Description, "CDomFunctions." & Err.Source, UNKNOWN)
    End If
End Function

Public Function AddEntityReference(oDOM As DOMDocument, _
                            oPNode As IXMLDOMNode, _
                            sEntity As String _
                            ) As Boolean
    On Error GoTo ErrHand
    
    Dim oNode As MSXML.IXMLDOMNode
    Dim entrefNode As MSXML.IXMLDOMEntityReference
    
    Call ClearErrorInfo
    
    Select Case oPNode.NodeType
        Case NODE_ATTRIBUTE, NODE_DOCUMENT_FRAGMENT, NODE_ENTITY_REFERENCE, NODE_ELEMENT:
            Set entrefNode = oDOM.createEntityReference(sEntity)
            oPNode.appendChild entrefNode
            AddEntityReference = True
        Case Else
            AddEntityReference = False
            Call SetErrorInfo(-1, "Invalid parent node type.", "CDomFunctions.AddEntityReference", HIERARCHY_REQUEST_ERR)
    End Select

ErrHand:
    If Err.Number <> 0 Then
    AddEntityReference = False
        Call SetErrorInfo(Err.Number, Err.Description, "CDomFunctions." & Err.Source, UNKNOWN)
    End If
End Function

Public Function AddNode(oDOM As DOMDocument, nIndex As Integer, _
                        nNodeType As DOMNodeType, _
                        sNodeName As String, _
                        sNodeContent As String _
                        ) As Boolean
                        
    Dim oNode As IXMLDOMNode
    
    AddNode = True
    
    If (IsNodeIndexOK(oDOM, nIndex)) Then
        Set oNode = oDOM.selectNodes("//").Item(nIndex)
        Select Case nNodeType
            Case NODE_ELEMENT
                If Not AddElement(oDOM, oNode, sNodeName, sNodeContent) Then
                    AddNode = False
                End If
            Case NODE_ATTRIBUTE
                If Not AddAttribute(oDOM, oNode, sNodeName, sNodeContent) Then
                    AddNode = False
                End If
           
            Case NODE_TEXT
                If Not AddTextNode(oDOM, oNode, sNodeContent) Then
                    AddNode = False
                End If
            
            Case NODE_CDATA_SECTION
                If Not AddCDATA(oDOM, oNode, sNodeContent) Then
                    AddNode = False
                End If
            
            Case NODE_ENTITY_REFERENCE
                If Not AddEntityReference(oDOM, oNode, sNodeName) Then
                    AddNode = False
                End If
            
            Case NODE_ENTITY
                AddNode = False
                Call SetErrorInfo(-1, "Not implememented", "CDomFucntions.AddNode", NOT_SUPPORTED_ERR)
                
            Case NODE_PROCESSING_INSTRUCTION
                If Not AddPI(oDOM, oNode, sNodeName, sNodeContent) Then
                    AddNode = False
                End If
                
            Case NODE_COMMENT
                If Not AddComment(oDOM, oNode, sNodeContent) Then
                    AddNode = False
                End If
            
            Case NODE_DOCUMENT
                AddNode = False
                Call SetErrorInfo(-1, "Not implememented", "CDomFucntions.AddNode", NOT_SUPPORTED_ERR)
            
            Case NODE_DOCUMENT_TYPE
                AddNode = False
                Call SetErrorInfo(-1, "Not implememented", "CDomFucntions.AddNode", NOT_SUPPORTED_ERR)
            
            Case NODE_DOCUMENT_FRAGMENT
                AddNode = False
                Call SetErrorInfo(-1, "Not implememented", "CDomFucntions.AddNode", NOT_SUPPORTED_ERR)
            
            Case NODE_NOTATION
                AddNode = False
                Call SetErrorInfo(-1, "Not implememented", "CDomFucntions.AddNode", NOT_SUPPORTED_ERR)
            
            Case Else
                AddNode = False
                Call SetErrorInfo(-1, "Unknown parent node type", "CDomFucntions.AddNode", NOT_SUPPORTED_ERR)
        End Select
    Else
        AddNode = False
        Call SetErrorInfo(-1, "Parent node index out-of-bounds.", "CDomFunctions.AddNode", INDEX_SIZE_ERR)
    End If

End Function

Public Function AddPI(oDOM As DOMDocument, _
                            oPNode As IXMLDOMNode, _
                            sTarget As String, _
                            sInstruction As String _
                            ) As Boolean
    On Error GoTo ErrHand
   

    Dim piNode As MSXML.IXMLDOMProcessingInstruction
    Dim bResults As Boolean
    
    Call ClearErrorInfo
    
    Select Case oPNode.NodeType
        Case NODE_DOCUMENT, NODE_DOCUMENT_FRAGMENT, _
             NODE_ENTITY_REFERENCE, NODE_ELEMENT:
            Set piNode = oDOM.createProcessingInstruction(sTarget, sInstruction)
            oPNode.appendChild piNode
            bResults = True
        Case Else
            bResults = False
            Call SetErrorInfo(-1, "Invalid parent node type.", _
                "CDomFunctions.AddPI", HIERARCHY_REQUEST_ERR)
    End Select
    
ErrHand:
    If Err.Number <> 0 Then
        bResults = False
        Call SetErrorInfo(Err.Number, Err.Description, "CDomFunctions." _
            & Err.Source, UNKNOWN)
    End If
    
    AddPI = bResults
End Function

Public Function AddTextNode(oDOM As DOMDocument, _
                            oPNode As IXMLDOMNode, _
                            sValue As String _
                            ) As Boolean
    On Error GoTo ErrHand
    
    Dim oNode As MSXML.IXMLDOMNode
    Dim elNode As MSXML.IXMLDOMText
    
    Call ClearErrorInfo
    
    Select Case oPNode.NodeType
        Case NODE_ATTRIBUTE, NODE_DOCUMENT_FRAGMENT, NODE_ENTITY_REFERENCE, NODE_ELEMENT:
            Set elNode = oDOM.createTextNode(sValue)
            oPNode.appendChild elNode
            AddTextNode = True
        Case Else
            AddTextNode = False
            Call SetErrorInfo(-1, "Invalid parent node type.", "CDomFunctions.AddTextNode", HIERARCHY_REQUEST_ERR)
    End Select
    
ErrHand:
    If Err.Number <> 0 Then
    AddTextNode = False
        Call SetErrorInfo(Err.Number, Err.Description, "CDomFunctions." & Err.Source, UNKNOWN)
    End If
End Function
Private Sub ClearErrorInfo()
    m_strErrorDescription = ""
    m_lngErrorNumber = 0
    m_strErrorSource = ""
    m_DomError = NO_ERROR
End Sub

Public Function DOMErrorToString(domError As DOMException) As String
    Select Case domError
        Case NO_ERROR: DOMErrorToString = "NO_ERROR"
        Case INDEX_SIZE_ERR: DOMErrorToString = "INDEX_SIZE_ERR"
        Case DOMSTRING_SIZE_ERR: DOMErrorToString = "DOMSTRING_SIZE_ERR"
        Case HIERARCHY_REQUEST_ERR: DOMErrorToString = "HIERARCHY_REQUEST_ERR"
        Case WRONG_DOCUMENT_ERR: DOMErrorToString = "WRONG_DOCUMENT_ERR"
        Case INVALID_CHARACTER_ERR: DOMErrorToString = "INVALID_CHARACTER_ERR"
        Case NO_DATA_ALLOWED_ERR: DOMErrorToString = "NO_DATA_ALLOWED_ERR"
        Case NO_MODIFICATION_ALLOWED_ERR: DOMErrorToString = "NO_MODIFICATION_ERR"
        Case NOT_FOUND_ERR: DOMErrorToString = "NOT_FOUND_ERR"
        Case NOT_SUPPORTED_ERR: DOMErrorToString = "NOT_SUPPORTED_ERR"
        Case INUSE_ATTRIBUTE_ERR: DOMErrorToString = "INUSE_ATTRIBUTE_ERR"
        Case Else:          DOMErrorToString = "UKNOWN"
End Select
End Function
Public Function GetAttributeNode(oEL As IXMLDOMElement, sAttrName As String) As IXMLDOMAttribute
    Dim oAttrTemp As IXMLDOMAttribute
    
    If Not IsNull(oEL.getAttribute(sAttrName)) Then
        Set GetAttributeNode = oEL.GetAttributeNode(sAttrName)
        Exit Function
    Else
        Set GetAttributeNode = oAttrTemp
    End If
End Function

Public Function RemoveAttributeNode(oEL As IXMLDOMElement, oAttr As IXMLDOMAttribute) As IXMLDOMAttribute
    Dim oAttrTemp As IXMLDOMAttribute
    Dim sAttrName As String
    sAttrName = oAttr.Name
    
    If Not IsNull(oEL.getAttribute(sAttrName)) Then
     ' Attribute exists, so we can remove it
     ' and return the removed node
        Set RemoveAttributeNode = oEL.RemoveAttributeNode(oAttr)
        Exit Function
    Else
        ' Return a Nothing node
        Set RemoveAttributeNode = oAttrTemp
    End If

End Function
Public Function RemoveNamedItem(oNode As IXMLDOMNode, oMap As IXMLDOMNamedNodeMap) As IXMLDOMNode
    Dim sName As String
    Dim oNodeTemp As IXMLDOMNode
    
    sName = oNode.baseName
    If oMap.getNamedItem(sName) Is Nothing Then
        ' This node doesn't exist, so we can't remove it.
        ' Return a Nothing node object
        Set RemoveNamedItem = oNodeTemp
        Exit Function
    Else ' Let's remove it, and return the vanished node
        Set RemoveNamedItem = oMap.getNamedItem(sName)
        oMap.RemoveNamedItem oNode
        Exit Function
    
    End If
End Function
Public Function SetNamedItem(oNode As IXMLDOMNode, oMap As IXMLDOMNamedNodeMap) As IXMLDOMNode
    Dim sName As String
    Dim oNodeTemp As IXMLDOMNode
    
    sName = oNode.baseName
    If oMap.getNamedItem(sName) Is Nothing Then
        ' This is a new node. Return a Nothing node object
        Set SetNamedItem = oNodeTemp
        oMap.SetNamedItem oNode
        Exit Function
    Else ' We're replacing. Return the replaced node
        Set SetNamedItem = oMap.getNamedItem(sName)
        oMap.SetNamedItem oNode
        Exit Function
    
    End If
End Function
'**********************************************************************
' Public Function GetElementText(oEl As IXMLDOMElement) As String
' Takes an Element node and returns the textual content as a single string
'**********************************************************************
Public Function GetElementText(oEL As IXMLDOMElement) As String
    On Error GoTo ErrHand
    
    Dim oTextNode As IXMLDOMText
    Dim nIdx As Integer
    Dim sElText As String
    
    ClearErrorInfo
    
    sElText = ""
    For nIdx = 0 To oEL.childNodes.length - 1
        If oEL.childNodes.Item(nIdx).NodeType = NODE_TEXT Then
            sElText = sElText & oEL.childNodes.Item(nIdx).nodeValue
        End If
    Next
 
    
ErrHand:
    If Err.Number <> 0 Then
        sElText = ""
        Call SetErrorInfo(Err.Number, Err.Description, _
            "CDomFunctions.GetElementText", UNKNOWN)
    End If
    
    GetElementText = sElText
End Function

Public Function GetErrorInfoXML() As String
    Dim s As String
    s = ""
    s = s & "<ERROR object='CDomFunctions'>" & vbCrLf
    s = s & "<NUMBER>" & CStr(m_lngErrorNumber) & "</NUMBER>" & vbCrLf
    s = s & "<SOURCE>" & m_strErrorSource & "</SOURCE>" & vbCrLf
    s = s & "<DESCRIPTION>" & m_strErrorDescription & "</DESCRIPTION>" & vbCrLf
    s = s & "<DOMERROR>" & DOMErrorToString(m_DomError) & "</DOMERROR>" & vbCrLf
    s = s & "</ERROR>"
    GetErrorInfoXML = s
End Function

Public Function InsertElementBefore(oDOM As DOMDocument, _
                    oRefNode As IXMLDOMNode, _
                    sElementName As String, _
                    sElementContent As String _
                    ) As Boolean
    On Error GoTo ErrHand
    
    Dim oNode As MSXML.IXMLDOMNode
    Dim elNode As MSXML.IXMLDOMElement
    Dim oPNode As IXMLDOMNode
    
    Call ClearErrorInfo
    
    
    ' Need to check that the element name is valid
    If Not ValidateElementType(sElementName) Then
        InsertElementBefore = False
        Call SetErrorInfo(-1, "Invalid element type", _
            "CDomFunctions.InsertElementBefore", INVALID_CHARACTER_ERR)
        Exit Function
    End If