cdomfunctions.cls

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

    Set oPNode = oRefNode.parentNode
    ' We need to check that the parent of the referring node
    ' will accept an Element node
    Select Case oPNode.NodeType
        Case NODE_DOCUMENT, NODE_DOCUMENT_FRAGMENT, NODE_ENTITY_REFERENCE, _
            NODE_ELEMENT:
            Set elNode = oDOM.createElement(sElementName)
            Set oNode = oPNode.insertBefore(elNode, oRefNode)
            If (Len(sElementContent)) Then
                oNode.Text = sElementContent
            End If
            InsertElementBefore = True
        Case Else
            InsertElementBefore = False
            Call SetErrorInfo(-1, "Invalid parent node type.", "CDomFunctions.InsertElementBefore", HIERARCHY_REQUEST_ERR)
    End Select

ErrHand:
    If Err.Number <> 0 Then
        InsertElementBefore = False
        Call SetErrorInfo(Err.Number, Err.Description, "CDomFunctions.InsertElementBefore " & Err.Source, UNKNOWN)
    End If
End Function
Public Function IsNodeIndexOK(oDOM As DOMDocument, nIndex As Integer) As Boolean
    If nIndex < 0 Then
        IsNodeIndexOK = False
    ElseIf nIndex > (oDOM.selectNodes("//").length - 1) Then
        IsNodeIndexOK = False
    Else
        IsNodeIndexOK = True
    End If
End Function

Public Function SearchAndReplace(oPNode As IXMLDOMNode, _
                                DomNodeTargetNodeType As DOMNodeType, _
                                sOldText As String, _
                                sNewText As String, _
                                Optional bLastFoundValue As Variant _
                                ) As Boolean
    On Error GoTo ErrHand
    
    Dim strTemp As String
    Dim nIdx As Integer
    Dim bFoundIt As Boolean
    
    ' We want to walk through the oPNode tree of nodes, looking for
    ' nodes of DomNodeTargetNodeType .  If we find any, we want to
    ' see if it contains text we can search and replace.
    ' First we need to see if the target node type can actually have
    ' any text.  If not, then return false and set the error info.
    
    
    If (Not bLastFoundValue) And (Not IsMissing(bLastFoundValue)) Then
        SearchAndReplace = False
        Call SetErrorInfo(-1, "Text not found", "CDomFunctions.SearchAndReplace", NOT_FOUND_ERR)
    End If
    
    'Default to False; we'll change this value if we actually replace anything
    If (IsMissing(bLastFoundValue)) Then
        bLastFoundValue = False
    End If
    
    bFoundIt = CBool(bLastFoundValue)
    
    Select Case DomNodeTargetNodeType
        Case NODE_ENTITY, NODE_DOCUMENT_TYPE, NODE_NOTATION, NODE_ENTITY_REFERENCE
            SearchAndReplace = False
            Call SetErrorInfo(-1, "Node and children are read-only", "CDomFunctions.SearchAndReplace", NO_MODIFICATION_ALLOWED_ERR)
            Exit Function
        Case Else
            ' Now see if the pNode is the type we're looking for
            If DomNodeTargetNodeType = oPNode.NodeType Then
                ' See what we can replace
                ' If the target type is Element or Attr, we'll interpret
                ' this to mean search and replace on the child nodes.
                Select Case oPNode.NodeType
                    Case NODE_TEXT
                        strTemp = oPNode.nodeValue
                        If InStr(strTemp, sOldText) Then
                            strTemp = Replace(strTemp, sOldText, sNewText)
                            oPNode.Text = strTemp
                            SearchAndReplace = True
                            bFoundIt = True
                            Call ClearErrorInfo
                        End If
                    Case NODE_CDATA_SECTION
                        strTemp = oPNode.nodeValue
                        If InStr(strTemp, sOldText) Then
                            strTemp = Replace(strTemp, sOldText, sNewText)
                            oPNode.Text = strTemp
                            SearchAndReplace = True
                            bFoundIt = True
                            Call ClearErrorInfo
                        End If
                    
                    Case NODE_COMMENT
                        strTemp = oPNode.nodeValue
                        If InStr(strTemp, sOldText) Then
                            strTemp = Replace(strTemp, sOldText, sNewText)
                            oPNode.Text = strTemp
                            SearchAndReplace = True
                            bFoundIt = True
                            Call ClearErrorInfo
                        End If
                    Case NODE_PROCESSING_INSTRUCTION
                        Dim pi As IXMLDOMProcessingInstruction
                        strTemp = oPNode.nodeValue
                        If InStr(strTemp, sOldText) Then
                            strTemp = Replace(strTemp, sOldText, sNewText)
                            oPNode.Text = strTemp
                            SearchAndReplace = True
                            bFoundIt = True
                            Call ClearErrorInfo
                        End If
                    
                    Case NODE_DOCUMENT_FRAGMENT, NODE_ELEMENT
                        For nIdx = 0 To oPNode.childNodes.length - 1
                            If (oPNode.childNodes(nIdx).NodeType = NODE_TEXT) Then
                                strTemp = oPNode.childNodes(nIdx).Text
                                If InStr(strTemp, sOldText) Then
                                    strTemp = Replace(strTemp, sOldText, sNewText)
                                    oPNode.childNodes(nIdx).Text = strTemp
                                    SearchAndReplace = True
                                    Call ClearErrorInfo
                                    bFoundIt = True
                                End If
                            ElseIf (oPNode.childNodes(nIdx).NodeType = NODE_ELEMENT) Then
                                ' Kepp walking the tree
                                bFoundIt = bFoundIt Or SearchAndReplace(oPNode.childNodes(nIdx), DomNodeTargetNodeType, sOldText, sNewText, bFoundIt)
                            End If
                         Next
                                            
                    Case Else
                        ' Error
                        SearchAndReplace = False
                        Call SetErrorInfo(-1, "Unexpected node type", "CDomFucntions.SearchAndReplace", UNKNOWN)
                        Exit Function
                End Select
            Else
                ' See if the parent node is an Attr; we won't
                ' see the attributes as child nodes, so just peek at
                ' them here and see if we can replace them
                If (DomNodeTargetNodeType = NODE_ATTRIBUTE) Then
                    If oPNode.NodeType = NODE_ELEMENT Then
                        For nIdx = 0 To oPNode.Attributes.length - 1
                            strTemp = oPNode.Attributes(0).nodeValue
                            If InStr(strTemp, sOldText) Then
                                strTemp = Replace(strTemp, sOldText, sNewText)
                                oPNode.Attributes(0).nodeValue = strTemp
                                SearchAndReplace = True
                                bFoundIt = True
                                Call ClearErrorInfo
                            End If
                        Next
                    End If
                End If
                ' Look at the parent node's children
                If oPNode.childNodes.length > 0 Then
                    For nIdx = 0 To oPNode.childNodes.length - 1
                        bFoundIt = bFoundIt Or SearchAndReplace(oPNode.childNodes(nIdx), DomNodeTargetNodeType, sOldText, sNewText, bFoundIt)
                    Next
                Else
                    ' All done
                    SearchAndReplace = bFoundIt
                    Exit Function
                End If
            End If
    End Select
    
    
ErrHand:
    If Err.Number <> 0 Then
        SearchAndReplace = False
        Call SetErrorInfo(Err.Number, Err.Description, "CDomFunctions.SearchAndReplace " & Err.Source, UNKNOWN)
        End If

End Function
Public Function SearchAndReplaceElementType( _
                            ByRef oDOM As DOMDocument, _
                            oNode As IXMLDOMNode, _
                            sOldType As String, _
                            sNewType As String, _
                            Optional bvFoundIt As Variant _
                                ) As Boolean
                                
    On Error GoTo ErrHand
    
    Dim oTempEl As IXMLDOMElement
    Dim oAttr As IXMLDOMAttribute
    Dim oPNode As IXMLDOMNode
    Dim nIdx As Integer
    Dim oFrag As IXMLDOMDocumentFragment
    Dim nChildCount As Integer
    Dim bReplacedIt As Boolean
    
    
    
    If (Not CBool(bvFoundIt)) And (Not IsMissing(bvFoundIt)) Then
        SearchAndReplaceElementType = False
        Call SetErrorInfo(-1, "Type not found", _
            "CDomFunctions.SearchAndReplaceElementType", NOT_FOUND_ERR)
    End If
    'Default to False; we'll change this value if we actually replace anything
    If IsMissing(bvFoundIt) Then
        bvFoundIt = False
    End If
    
    bReplacedIt = CBool(bvFoundIt)
    Select Case oNode.NodeType
    Case NODE_ELEMENT
        If oNode.baseName = sOldType Then
            Set oTempEl = oDOM.createElement(sNewType)
            For nIdx = 0 To oNode.childNodes.length - 1
                Call oTempEl.appendChild(oNode.childNodes(nIdx).cloneNode(True))
                Debug.Print "oTempEl.xml = " & oTempEl.xml
            Next
            For nIdx = 0 To oNode.Attributes.length - 1
                Call AddAttribute(oDOM, oTempEl, oNode.Attributes(nIdx).nodeName, _
                    oNode.Attributes(nIdx).nodeValue)
            Next
            Set oPNode = oNode.parentNode
            Call oPNode.replaceChild(oTempEl, oNode)
            SearchAndReplaceElementType = True
            bReplacedIt = True
            Call ClearErrorInfo
        End If
        ' Now traverse the child nodes, if any
        For nIdx = 0 To oNode.childNodes.length - 1
            bReplacedIt = bReplacedIt Or _
                SearchAndReplaceElementType(oDOM, _
                        oNode.childNodes(nIdx), sOldType, _
                        sNewType, bReplacedIt)
        Next
    Case NODE_DOCUMENT, NODE_DOCUMENT_FRAGMENT
        For nIdx = 0 To oNode.childNodes.length - 1
            bReplacedIt = bReplacedIt Or SearchAndReplaceElementType(oDOM, _
                oNode.childNodes(nIdx), sOldType, sNewType, bReplacedIt)
        Next
        
    Case Else
        ' Well, this isn't an node that can have element children we can edit
        SearchAndReplaceElementType = bReplacedIt
        Exit Function
    End Select
   
    SearchAndReplaceElementType = bReplacedIt
    Exit Function
    
ErrHand:
    If Err.Number <> 0 Then
        SearchAndReplaceElementType = False
        Call SetErrorInfo(Err.Number, Err.Description, _
            "CDomFunctions.SearchAndReplaceElementType" & Err.Source, UNKNOWN)
        End If

End Function

Private Sub SetErrorInfo(lngErrNum As Long, strErrDesc As String, strErrSource As String, domErr As DOMException)
    m_strErrorDescription = strErrDesc
    m_lngErrorNumber = lngErrNum
    m_strErrorSource = strErrSource
  
    m_DomError = domErr
End Sub
Public Function SplitTextNode(oTextNode As IXMLDOMText, nOffset As Integer) As IXMLDOMText
    Dim oTempTextNode As IXMLDOMText
    
    If (nOffset < 0) Or (nOffset > Len(oTextNode.nodeValue)) Then
        Set SplitTextNode = oTempTextNode
        Call SetErrorInfo(-1, "Offset out-of-bounds", "CDomFunctions.SplitTextNode", INDEX_SIZE_ERR)
        Exit Function
    Else
        Set SplitTextNode = oTextNode.splitText(nOffset)
    End If
End Function

Public Function TextDeleteData(oTextNode As IXMLDOMText, nOffset As Integer, nCount As Integer) As Boolean
    If (nOffset < 0) Or (nOffset > Len(oTextNode.Data) - 1) Then
        TextDeleteData = False
        Call SetErrorInfo(-1, "Offset out-of-bounds", "CDomFunctions.TextDeleteData", INDEX_SIZE_ERR)
        Exit Function
    Else
        Call oTextNode.deleteData(nOffset, nCount)
        TextDeleteData = True
    End If
End Function

Public Function TextInsertData(oTextNode As IXMLDOMText, nOffset As Integer, sData As String) As Boolean
    If (nOffset < 0) Or (nOffset > Len(oTextNode.Data) - 1) Then
        TextInsertData = False
        Call SetErrorInfo(-1, "Offset out-of-bounds", "CDomFunctions.TextInsertData", INDEX_SIZE_ERR)
        Exit Function
    Else
        Call oTextNode.insertData(nOffset, sData)
        TextInsertData = True
    End If
End Function

Public Function TextReplaceData(oTextNode As IXMLDOMText, nOffset As Integer, _
                nCount As Integer, sData As String) As Boolean
    If (nOffset < 0) Or (nOffset > Len(oTextNode.Data) - 1) Then
        TextReplaceData = False
        Call SetErrorInfo(-1, "Offset out-of-bounds", "CDomFunctions.TextReplaceData", INDEX_SIZE_ERR)
        Exit Function
    Else
        Call oTextNode.replaceData(nOffset, nCount, sData)
        TextReplaceData = True
    End If
End Function

Public Function ValidateElementType(strTagName As String) As Boolean
    ' An element tag name may begin with only certain characters.
    ' rather than test for them all, let's let the parser do it ...
    Dim oDOM As DOMDocument
    Dim sXML As String
    
    Set oDOM = New DOMDocument
    sXML = "<" & strTagName & "/>"
    If Not oDOM.loadXML(sXML) Then
        ValidateElementType = False
        Exit Function
    End If
    
    
    ValidateElementType = True
    
End Function


Private Sub Class_Initialize()
    Call ClearErrorInfo
End Sub