用戶登錄  |  用戶注冊
首 頁源碼下載網絡學院最新源碼源碼排行屏蔽廣告
當前位置:新興網絡 > 網絡學院 > Asp編程 > Asp 實例

ASP XML操作類

減小字體 增大字體 作者:佚名  來源:本站整理  發布時間:2010-10-25 16:38:04

ASP XML操作類,包括:建立一個XML文件、刪除節點、清空節點、添加節點、添加節點屬性等等操作。

ASP code復制代碼
<%
Class XMLDOMDocument
    Private fNode, fANode
    Private fErrInfo, fFileName, fOpen
    Dim XmlDom

    '返回節點的縮進字串
    Private Property Get TabStr(ByVal Node)
        TabStr = ""
        If Node Is Nothing Then Exit Property
        If Not Node.parentNode Is Nothing Then TabStr = "  " & TabStr(Node.parentNode)
    End Property

    '返回一個子節點對象,ElementOBJ為父節點,ChildNodeObj要查找的節點,IsAttributeNode指出是否為屬性對象
    Public Property Get ChildNode(ByVal ElementOBJ, ByVal ChildNodeObj, ByVal IsAttributeNode)
        Dim Element
        Set ChildNode = Nothing

        If IsNull(ChildNodeObj) Then
            If IsAttributeNode = False Then
                Set ChildNode = fNode
            Else
                Set ChildNode = fANode
            End If
            Exit Property
        ElseIf IsObject(ChildNodeObj) Then
            Set ChildNode = ChildNodeObj
            Exit Property
        End If

        Set Element = Nothing
        If LCase(TypeName(ChildNodeObj)) = "string" And Trim(ChildNodeObj) <> "" Then
            If IsNull(ElementOBJ) Then
                Set Element = fNode
            ElseIf LCase(TypeName(ElementOBJ)) = "string" Then
                If Trim(ElementOBJ) <> "" Then
                    Set Element = XmlDom.SelectSingleNode("//" & Trim(ElementOBJ))
                    If LCase(Element.nodeTypeString) = "attribute" Then Set Element = Element.SelectSingleNode("..")
                End If
            ElseIf IsObject(ElementOBJ) Then
                Set Element = ElementOBJ
            End If

            If Element Is Nothing Then
                Set ChildNode = XmlDom.SelectSingleNode("//" & Trim(ChildNodeObj))
            ElseIf IsAttributeNode = True Then
                Set ChildNode = Element.SelectSingleNode("./@" & Trim(ChildNodeObj))
            Else
                Set ChildNode = Element.SelectSingleNode("./" & Trim(ChildNodeObj))
            End If
        End If
    End Property

    '讀取最后的錯誤信息
    Public Property Get ErrInfo()
        ErrInfo = fErrInfo
    End Property

    '給xml內容
    Public Property Get xmlText(ByVal ElementOBJ)
        xmlText = ""
        If fOpen = False Then Exit Property

        Set ElementOBJ = ChildNode(XmlDom, ElementOBJ, False)
        If ElementOBJ Is Nothing Then Set ElementOBJ = XmlDom

        xmlText = ElementOBJ.xml
    End Property

    '=================================================================
    '類初始化
    Private Sub Class_Initialize()
        Set XmlDom = CreateObject("Microsoft.XMLDOM")
        XmlDom.preserveWhiteSpace = True

        Set fNode = Nothing
        Set fANode = Nothing

        fErrInfo = ""
        fFileName = ""
        fOpen = False
    End Sub

    '類釋放
    Private Sub Class_Terminate()
        Set fNode = Nothing
        Set fANode = Nothing
        Set XmlDom = Nothing
        fOpen = False
    End Sub

    '=====================================================================
    '建立一個XML文件,RootElementName:根結點名。XSLURL:使用XSL樣式地址
    '返回根結點
    Function Create(ByVal RootElementName, ByVal XslUrl)
        Dim PINode, RootElement

        Set Create = Nothing

        If (XmlDom Is Nothing) Or (fOpen = True) Then Exit Function

        If Trim(RootElementName) = "" Then RootElementName = "Root"

        Set PINode = XmlDom.CreateProcessingInstruction("xml", "version=""1.0""  encoding=""GB2312""")
        XmlDom.appendChild PINode

        Set PINode=XMLDOM.CreateProcessingInstruction("xml-stylesheet", "type=""text/xsl"" href="""&XslUrl&"""")
        XmlDom.appendChild PINode

        Set RootElement = XmlDom.CreateElement(Trim(RootElementName))
        XmlDom.appendChild RootElement

        Set Create = RootElement

        fOpen = True
        Set fNode = RootElement
    End Function

    '開打一個已經存在的XML文件,返回打開狀態
    Function Open(byVal xmlSourceFile)
        Open=false

        xmlSourceFile = Trim(xmlSourceFile)
        If xmlSourceFile = "" Then Exit Function

        XmlDom.async = False
        XmlDom.Load xmlSourceFile

        fFileName = xmlSourceFile

        If Not IsError Then
            Open=true
            fOpen = True
        End If
    End Function

    '關閉
    Sub Close()
        Set fNode = Nothing
        Set fANode = Nothing

        fErrInfo = ""
        fFileName = ""
        fOpen = False
    End Function

    '讀取一個NodeOBJ的節點Text的值
    'NodeOBJ可以是節點對象或節點名,為null就取當前默認fNode
    Function getNodeText(ByVal NodeOBJ)
        getNodeText = ""
        If fOpen = False Then Exit Function

        Set NodeOBJ = ChildNode(Null, NodeOBJ, False)
        If NodeOBJ Is Nothing Then Exit Function

        If LCase(NodeOBJ.nodeTypeString) = "element" Then
            Set fNode = NodeOBJ
        Else
            Set fANode = NodeOBJ
        End If
        getNodeText = NodeOBJ.Text
    End Function

    '插入在BefelementOBJ下面一個名為ElementName,Value為ElementText的子節點。
    'IsFirst:是否插在第一個位置;IsCDATA:說明節點的值是否屬于CDATA類型
    '插入成功就返回新插入這個節點
    'BefelementOBJ可以是對象也可以是節點名,為null就取當前默認對象
    Function InsertElement(ByVal BefelementOBJ, ByVal ElementName, ByVal ElementText, ByVal IsFirst, ByVal IsCDATA)
        Dim Element, TextSection, SpaceStr
        Set InsertElement = Nothing

        If Not fOpen Then Exit Function

        Set BefelementOBJ = ChildNode(XmlDom, BefelementOBJ, False)
        If BefelementOBJ Is Nothing Then Exit Function

        Set Element = XmlDom.CreateElement(Trim(ElementName))

        'SpaceStr=vbCrLf&TabStr(BefelementOBJ)
        'Set STabStr=XmlDom.CreateTextNode(SpaceStr)

        'If Len(SpaceStr)>2 Then  SpaceStr=Left(SpaceStr,Len(SpaceStr)-2)
        'Set ETabStr=XmlDom.CreateTextNode(SpaceStr)

        If IsFirst = True Then
            'BefelementOBJ.InsertBefore ETabStr,BefelementOBJ.firstchild
            BefelementOBJ.InsertBefore Element, BefelementOBJ.firstchild
            'BefelementOBJ.InsertBefore STabStr,BefelementOBJ.firstchild
        Else
            'BefelementOBJ.appendChild STabStr
            BefelementOBJ.appendChild Element
            'BefelementOBJ.appendChild ETabStr
        End If

        If IsCDATA = True Then
            Set TextSection = XmlDom.createCDATASection(ElementText)
            Element.appendChild TextSection
        ElseIf ElementText <> "" Then
            Element.Text = ElementText
        End If

        Set InsertElement = Element
        Set fNode = Element
    End Function

    '在ElementOBJ節點上插入或修改名為AttributeName,值為:AttributeText的屬性
    '如果已經存在名為AttributeName的屬性對象,就進行修改。
    '返回插入或修改屬性的Node
    'ElementOBJ可以是Element對象或名,為null就取當前默認對象
    Function setAttributeNode(ByVal ElementOBJ, ByVal AttributeName, ByVal AttributeText)
        Dim AttributeNode
        Set setAttributeNode = Nothing

        If Not fOpen Then Exit Function

        Set ElementOBJ = ChildNode(XmlDom, ElementOBJ, False)
        If ElementOBJ Is Nothing Then Exit Function

        Set AttributeNode = ElementOBJ.Attributes.getNamedItem(AttributeName)
        If AttributeNode Is Nothing Then
            Set AttributeNode = XmlDom.CreateAttribute(AttributeName)
            ElementOBJ.setAttributeNode AttributeNode
        End If
        AttributeNode.Text = AttributeText

        Set fNode = ElementOBJ
        Set fANode = AttributeNode
        Set setAttributeNode = AttributeNode
    End Function

    '修改ElementOBJ節點的Text值,并返回這個節點
    'ElementOBJ可以對象或對象名,為null就取當前默認對象
    Function UpdateNodeText(ByVal ElementOBJ, ByVal NewElementText, ByVal IsCDATA)
        Dim TextSection

        Set UpdateNodeText = Nothing
        If Not fOpen Then Exit Function

        Set ElementOBJ = ChildNode(XmlDom, ElementOBJ, False)
        If ElementOBJ Is Nothing Then Exit Function

        If IsCDATA = True Then
            Set TextSection = XmlDom.createCDATASection(NewElementText)
            If ElementOBJ.firstchild Is Nothing Then
                ElementOBJ.appendChild TextSection
            ElseIf LCase(ElementOBJ.firstchild.nodeTypeString) = "cdatasection" Then
                ElementOBJ.replaceChild TextSection, ElementOBJ.firstchild
            End If
        Else
            ElementOBJ.Text = NewElementText
        End If

        Set fNode = ElementOBJ
        Set UpdateNodeText = ElementOBJ
    End Function

    '返回符合testValue條件的第一個ElementNode,為null就取當前默認對象
    Function getElementNode(ByVal ElementName, ByVal testValue)
        Dim Element, regEx, baseName

        Set getElementNode = Nothing
        If Not fOpen Then Exit Function

        testValue = Trim(testValue)
        Set regEx = New RegExp
        regEx.Pattern = "^[A-Za-z]+"
        regEx.IgnoreCase = True
        If regEx.Test(testValue) Then testValue = "/" & testValue
        Set regEx = Nothing

        baseName = LCase(Right(ElementName, Len(ElementName) - InStrRev(ElementName, "/", -1)))

        Set Element=XmlDom.SelectSingleNode("//"&ElementName&testValue)

        If Element Is Nothing Then
            'Response.write ElementName&testValue
            Set getElementNode = Nothing
            Exit Function
        End If

        Do While LCase(Element.baseName) <> baseName
            Set Element = Element.SelectSingleNode("..")
            If Element Is Nothing Then Exit Do
        Loop

        If LCase(Element.baseName) <> baseName Then
            Set getElementNode = Nothing
        Else
            Set getElementNode = Element
            If LCase(Element.nodeTypeString) = "element" Then
                Set fNode = Element
            Else
                Set fANode = Element
            End If
        End If
    End Function

    '刪除一個子節點
    Function removeChild(ByVal ElementOBJ)
        removeChild = False
        If Not fOpen Then Exit Function

        Set ElementOBJ = ChildNode(Null, ElementOBJ, False)
        If ElementOBJ Is Nothing Then Exit Function

        'response.write ElementOBJ.baseName

        If LCase(ElementOBJ.nodeTypeString) = "element" Then
            If ElementOBJ Is fNode Then Set fNode = Nothing
            If ElementOBJ.parentNode Is Nothing Then
                XmlDom.removeChild (ElementOBJ)
            Else
                ElementOBJ.parentNode.removeChild (ElementOBJ)
            End If
            removeChild = True
        End If
    End Function

    '清空一個節點所有子節點
    Function ClearNode(ByVal ElementOBJ)
        Set ClearNode = Nothing
        If Not fOpen Then Exit Function

        Set ElementOBJ = ChildNode(Null, ElementOBJ, False)
        If ElementOBJ Is Nothing Then Exit Function

        ElementOBJ.Text = ""
        ElementOBJ.removeChild (ElementOBJ.firstchild)

        Set ClearNode = ElementOBJ
        Set fNode = ElementOBJ
    End Function

    '刪除子節點的一個屬性
    Function removeAttributeNode(ByVal ElementOBJ, ByVal AttributeOBJ)
        removeAttributeNode = False
        If Not fOpen Then Exit Function

        Set ElementOBJ = ChildNode(XmlDom, ElementOBJ, False)
        If ElementOBJ Is Nothing Then Exit Function

        Set AttributeOBJ = ChildNode(ElementOBJ, AttributeOBJ, True)
        If Not AttributeOBJ Is Nothing Then
            ElementOBJ.removeAttributeNode (AttributeOBJ)
            removeAttributeNode = True
        End If
    End Function

    '保存打開過的文件,只要保證FileName不為空就可以實現保存
    Function Save()
        On Error Resume Next
        Save = False
        If (Not fOpen) Or (fFileName = "") Then Exit Function

        XmlDom.Save fFileName
        Save = (Not IsError)
        If Err.Number <> 0 Then
            Err.Clear
            Save = False
        End If
    End Function

    '另存為XML文件,只要保證FileName不為空就可以實現保存
    Function SaveAs(SaveFileName)
        On Error Resume Next
        SaveAs = False
        If (Not fOpen) Or SaveFileName = "" Then Exit Function
        XmlDom.Save SaveFileName
        SaveAs = (Not IsError)
        If Err.Number <> 0 Then
            Err.Clear
            SaveAs = False
        End If
    End Function

    '檢查并打印錯誤信息
    Private Function IsError()
        If XmlDom.ParseError.errorcode <> 0 Then
            fErrInfo="<h1>Error"&XmlDom.ParseError.errorcode&"</h1>"
            fErrInfo=fErrInfo&"<B>Reason :</B>"&XmlDom.ParseError.reason&"<br>"
            fErrInfo=fErrInfo&"<B>URL    :</B>"&XmlDom.ParseError.url&"<br>"
            fErrInfo=fErrInfo&"<B>Line   :</B>"&XmlDom.ParseError.line&"<br>"
            fErrInfo=fErrInfo&"<B>FilePos:</B>"&XmlDom.ParseError.filepos&"<br>"
            fErrInfo=fErrInfo&"<B>srcText:</B>"&XmlDom.ParseError.srcText&"<br>"
            IsError = True
        Else
            IsError = False
        End If
    End Function
End Class
%>
 

Tags:XMLDOM XML ASP

作者:佚名
  • 好的評價 如果您覺得此文章好,就請您
      0%(0)
  • 差的評價 如果您覺得此文章差,就請您
      0%(0)

網絡學院評論評論內容只代表網友觀點,與本站立場無關!

   評論摘要(共 0 條,得分 0 分,平均 0 分) 查看完整評論
175哪个门派赚钱快 北京pk赛车开奖app 河北十一选五跨度走势 网页版股票行情 十一选五一定牛吉林 黑龙江11选5同步开奖 快乐双彩网走势图表图 基金配资比例 时时彩平台违法 福建快3开今日开奖号码表 山东体彩11选五最大遗漏