sliceparser.class.asp

一个很好的asp cms管理系统

<%
Class SliceParser
    Private XMLPath, XMLDoc, XMLRoot, XMLNode, TParser
    Private NodeCommand, CommandType, CommandTable
    Public Version, Author, CreateTime, Description

    Private Sub Class_Initialize
        On Error Resume Next
        Set XMLDoc = Server.CreateObject(Cfg.XMLObject_Name)
        XMLDoc.async = FALSE
        XMLDoc.resolveExternals = FALSE
        If Err.Number<>0 And XMLDoc Is Nothing Then
            Response.Write "<font color=""red"">“" & Cfg.XMLObject_Name & "”无法创建</font>"
            Response.End
        End If

        Set TParser = New TagParser

    End Sub

    Public Function Compile(XMLval)

        If XMLval = "" Or IsNUll(XMLval) Then
            Compile = ""
            Exit Function
        End If

        If Not XMLDoc.loadXML(XMLval) Then
            Compile = ""
            Exit Function
        End If
        Set XMLRoot = XMLDoc.documentElement

        Set XMLNode = XMLRoot.selectSingleNode("/slice")
        Version = XMLNode.getAttribute("version")
        Set XMLNode = XMLRoot.selectSingleNode("/slice/author")
        Author = XMLNode.text
        Set XMLNode = XMLRoot.selectSingleNode("/slice/createtime")
        CreateTime = XMLNode.text
        Set XMLNode = XMLRoot.selectSingleNode("/slice/description")
        Description = XMLNode.text

        Set NodeCommand = XMLRoot.selectSingleNode("/slice/command")
        CommandType = NodeCommand.getAttribute("type")
        CommandTable = NodeCommand.getAttribute("table")

        Dim strResult
        Select Case CommandType & "_" & CommandTable
            Case "loop_view_resource"
                Compile = loop_view_resource()
            Case Else
                Compile = ""
        End Select

    End Function

    Private Function loop_view_resource()
        Dim I, strCode, Sql, Rs, sqlWhere, tmpSql
        Dim pTop, pClassList, pSpecialList, pIdList, pOrderBy
        Dim strHtml, tmpHtml

        Set XMLNode = NodeCommand.selectSingleNode("./parameter")
        If XMLNode.getAttribute("type") = "custome" Then
            Set XMLNode = NodeCommand.selectSingleNode("./parameter/sql")
            Sql = XMLNode.text
        Else
            Sql = "SELECT $TOP$ * FROM view_resource WHERE $WHERE$ ORDER BY $ORDER$"
            sqlWhere = "1<>2"

            ''处理频道列表
            Set XMLNode = NodeCommand.selectNodes("./parameter/class_list/item")
            If Not XMLNode Is Nothing Then
                Dim myNode, IdList, ChildIdlist
                For I = 0 To XMLNode.Length-1
                    ChildIdlist = ""
                    Set myNode = XMLNode.item(I)
                    If myNode.getAttribute("child") = 1 Then
                        ChildIdlist = FLib.ChildenList(myNode.text)
                    End If
                    If ChildIdlist <> "" Then
                        ChildIdlist = ChildIdlist & ","
                    End If
                    ChildIdlist = ChildIdlist & myNode.text
                    If IdList <> "" Then
                        IdList = IdList & ","
                    End If
                    IdList = IdList & ChildIdlist
                Next

                If IdList<> "" Then
                    sqlWhere = sqlWhere & " AND class_id IN (" & IdList & ")"
                End If
            End If

            ''处理Top参数
            Set XMLNode = NodeCommand.selectSingleNode("./parameter/top")
            If XMLNode Is Nothing Then
                pTop = ""
            Else
                pTop = " TOP " & XMLNode.text
            End If

            ''处理特性列表
            tmpSql = ""
            Set XMLNode = NodeCommand.selectNodes("./parameter/special_list/item")
            If Not XMLNode Is Nothing Then
                For I = 0 To XMLNode.Length-1
                    Set myNode = XMLNode.item(I)
                    If tmpSql <> "" Then
                        tmpSql = tmpSql & " OR"
                    End If
                    tmpSql = tmpSql & " INSTR(',' + special + ',', '," & myNode.text & ",') <> 0"
                Next

                If tmpSql <> "" Then
                    sqlWhere = sqlWhere & " AND (" & tmpSql & " )"
                End If
            End If

            ''处理字段
            tmpSql = ""
            Set XMLNode = NodeCommand.selectNodes("./parameter/filed_list/item")
            If Not XMLNode Is Nothing Then
                For I=0 To XMLNode.Length-1
                    Set myNode = XMLNode.item(I)
                    If tmpSql <> "" Then
                        tmpSql = tmpSql & " OR"
                    End If
                    Select Case myNode.getAttribute("type")
                        Case "equal":
                            tmpSql = tmpSql & " " & myNode.getAttribute("name") & " = " & myNode.text
                        Case "like":
                            tmpSql = tmpSql & " " & myNode.getAttribute("name") & " LIKE " & myNode.text
                        Case "in":
                            tmpSql = tmpSql & " " & myNode.getAttribute("name") & " IN " & myNode.text
                    End Select
                Next

                If tmpSql <> "" Then
                    sqlWhere = sqlWhere & " AND (" & tmpSql & " )"
                End If
            End If
            
            ''处理排序参数
            Set XMLNode = NodeCommand.selectNodes("./parameter/orderby/item")
            If Not XMLNode Is Nothing Then
				For I=0 To XMLNode.Length-1
					Set myNode = XMLNode.item(I)
                    If pOrderBy <> "" Then
                        pOrderBy = pOrderBy & ","
                    End If
					pOrderBy = pOrderBy & " " & myNode.text
                    If myNode.getAttribute("method") = "desc" Then
                        pOrderBy = pOrderBy & myNode.getAttribute("name") & " DESC"
					Else
						pOrderBy = pOrderBy & myNode.getAttribute("name") & " ASC"
                    End If
				Next
			Else
				pOrderBy = "addtime DESC"
			End If

            ''替换Sql
            Sql = Replace(Sql, "$TOP$", pTop)
            Sql = Replace(Sql, "$WHERE$", sqlWhere)
					If pOrderBy = "" Then
                        pOrderBy = "addtime DESC"
                    End If
            Sql = Replace(Sql, "$ORDER$", pOrderBy)

		End If
            Set Rs = Db.ExeCute(Sql)

            If Rs.Eof And Rs.Bof Then
                Set XMLNode = NodeCommand.selectSingleNode("./body/empty")
                If XMLNode Is Nothing Then
                    strHtml = ""
                Else
                    strHtml = XMLNode.text
                End If
            Else
                Dim StartNum, EndNum, oddrowHtml, evenrowHtml, defaultHtml, rowTemplate
                StartNum = EndNum = 0
                Set XMLNode = NodeCommand.selectSingleNode("./body/loop")
                If Not XMLNode Is Nothing Then

                    StartNum        = CInt(XMLNode.getAttribute("start"))
                    EndNum          = CInt(XMLNode.getAttribute("end"))
                    oddrowHtml      = XMLNode.selectSingleNode("oddrow").text
                    evenrowHtml     = XMLNode.selectSingleNode("evenrow").text
                    defaultHtml     = XMLNode.selectSingleNode("default").text
                    rowTemplate     = ""
                    strHtml         = ""
                    I = 0

                    While Not Rs.Eof
                        I = I+1
                        If I >= StartNum And I <= EndNum Then
                            If I Mod 2 = 0 Then
                                rowTemplate = oddrowHtml
                            Else
                                rowTemplate = evenrowHtml
                            End If

                            If rowTemplate = "" Then
                                rowTemplate = defaultHtml
                            End If
                            strHtml = strHtml & TParser.Parser(Rs, rowTemplate)
                        End If
                        Rs.MoveNext
                    Wend

                Else
                    strHtml = ""
                End If
            End If
            Rs.Close()
            strHtml =  NodeCommand.selectSingleNode("./body/head").text & strHtml & NodeCommand.selectSingleNode("./body/foot").text

        loop_view_resource = strHtml

    End Function

    ''注消类
    Private Sub Class_Terminate
        Set XMLDoc = Nothing
        Set TParser = Nothing
    End Sub

End Class

%>