dyna_page.asp

个人网站比较简短

<!--#include file="Start.asp"-->
<!--#include file="Include/PowerEasy.Cache.asp"-->
<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Response.ContentType = "text/xml; charset=gb2312"
    
Dim strtmp, SubNode, DynaDom, DynaNode

Set XMLDOM = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
strtmp = "<?xml version=""1.0"" encoding=""gb2312""?>"

XMLDOM.appendChild (XMLDOM.createProcessingInstruction("xml", "version=""1.0"" encoding=""gb2312"""))
XMLDOM.appendChild (XMLDOM.createElement("root"))
XMLDOM.documentElement.Attributes.setNamedItem(XMLDOM.createNode(2, "version", "")).Text = "PowerEasy Cms 2006"


'接收数据
Set DynaDom = CreateObject("Microsoft.XMLDOM")
DynaDom.async = False
DynaDom.Load Request
Set DynaNode = DynaDom.getElementsByTagName("root")
If DynaNode.length < 1 Then
    Set Node = XMLDOM.createNode(1, "serverbackinfo", "")
    XMLDOM.documentElement.appendChild (Node)
    Set SubNode = Node.appendChild(XMLDOM.createElement("stat"))
    SubNode.Text = "err"
    Set SubNode = Node.appendChild(XMLDOM.createElement("infomation"))
    SubNode.Text = "输入数据错误!"
Else
    Dim id, page, tempvaluearr
    id = PE_CLng(DynaNode(0).selectSingleNode("id").Text)
    If id > 0 Then
        If PE_CLng(DynaNode(0).selectSingleNode("page").Text) > 0 Then
            page = PE_CLng(DynaNode(0).selectSingleNode("page").Text)
        Else
            page = 1
        End If
        If DynaNode(0).selectSingleNode("value").Text <> "" Then
            tempvaluearr = Split(DynaNode(0).selectSingleNode("value").Text, "|")
        End If

        '开始输出动态标签内容
        Dim rsLabel
        Set rsLabel = Conn.Execute("select LabelID,LabelName,LabelType,PageNum,LabelIntro,LabelContent from PE_Label where LabelID=" & id)
        If rsLabel.BOF And rsLabel.EOF Then
            Set Node = XMLDOM.createNode(1, "serverbackinfo", "")
            XMLDOM.documentElement.appendChild (Node)
            Set SubNode = Node.appendChild(XMLDOM.createElement("stat"))
            SubNode.Text = "err"
            Set SubNode = Node.appendChild(XMLDOM.createElement("infomation"))
            SubNode.Text = "标签不存在!"
        Else
            '找到标签进行处理
            Dim rsLabelRe, PageNum, TempSql, LoopTemp, loopTempMatch, InfoID, tempvalue
            Dim DyTemp, j, InfoTemp, InfoTempMatch, MatchesInfo, FieldTemp, FieldArry, FieldTempText
            PageNum = rsLabel("PageNum")

            LoopTemp = rsLabel("LabelContent")
            LoopTemp = Replace(Replace(Replace(Replace(LoopTemp, "{$Now}", Now()), "{$NowDay}", Day(Now())), "{$NowMonth}", Month(Now())), "{$NowYear}", Year(Now()))
            LoopTemp = Replace(Replace(Replace(Replace(LoopTemp, "{$PE_True}", PE_True), "{$PE_False}", PE_False), "{$PE_Now}", PE_Now), "{$PE_OrderType}", PE_OrderType)
            If rsLabel("LabelType") = 3 Then '函数型动态标签的处理过程
                 For j = 0 To UBound(tempvaluearr)
                     LoopTemp = Replace(LoopTemp, "{input(" & j & ")}", tempvaluearr(j))
                 Next
            End If

            regEx.Pattern = "\{Loop\}([\s\S]*?)\{\/Loop\}"
            Set Matches = regEx.Execute(LoopTemp)
            For Each Match In Matches
                loopTempMatch = Match.Value
            Next
            LoopTemp = regEx.Replace(LoopTemp, "{$SqlReplaceText}")
            loopTempMatch = Replace(Replace(loopTempMatch, "{loop}", ""), "{/loop}", "")

            TempSql = Replace(Replace(Replace(Replace(rsLabel("LabelIntro"), "{$Now}", Now()), "{$NowDay}", Day(Now())), "{$NowMonth}", Month(Now())), "{$NowYear}", Year(Now()))
            If rsLabel("LabelType") = 3 Then '函数型动态标签的处理过程
                For j = 0 To UBound(tempvaluearr) - 1
                    TempSql = Replace(TempSql, "{input(" & j & ")}", ReplaceBadChar(tempvaluearr(j)))
                Next
            End If
                '开始循环处理内容
                Dim totalpage, iMod
                InfoID = 0
                On Error Resume Next
                Set rsLabelRe = Server.CreateObject("adodb.recordset")
                rsLabelRe.Open TempSql, Conn, 1, 1
                If Err Then
                    Err.Clear
                    DyTemp = "SQL查询错"
                Else
                    totalPut = rsLabelRe.RecordCount
                    If (totalPut Mod PageNum) = 0 Then
                        totalpage = totalPut \ PageNum
                    Else
                        totalpage = totalPut \ PageNum + 1
                    End If
                    If page < 1 Then
                        page = 1
                    End If
                    If (page - 1) * PageNum > totalPut Then
                        If (totalPut Mod PageNum) = 0 Then
                            page = totalPut \ PageNum
                        Else
                            page = totalPut \ PageNum + 1
                        End If
                    End If
                    If page > 1 Then
                        If (page - 1) * PageNum < totalPut Then
                            iMod = 0
                            If page > PageNum Then
                                iMod = totalPut Mod PageNum
                                If iMod <> 0 Then iMod = PageNum - iMod
                            End If
                            rsLabelRe.Move (page - 1) * PageNum - iMod
                        Else
                            page = 1
                        End If
                    End If

                    If rsLabelRe.BOF And rsLabelRe.EOF Then
                        DyTemp = "无数据"
                    Else
                        Do While Not rsLabelRe.EOF
                        regEx.Pattern = "\{Infobegin\}([\s\S]*?)\{Infoend\}"
                        Set Matches = regEx.Execute(loopTempMatch)
                        If Matches.Count = 0 Then
                            rsLabelRe.MoveNext
                        Else
                            For Each Match In Matches
                                If Not rsLabelRe.EOF Then
                                    InfoTemp = Match.Value
                                    InfoTempMatch = Replace(Replace(InfoTemp, "{Infobegin}", ""), "{Infoend}", "") '得到最终的单一字段内容
                                    regEx.Pattern = "\{\$Field\((.*?)\)\}"
                                    Set MatchesInfo = regEx.Execute(InfoTempMatch)
                                    For Each Match2 In MatchesInfo
                                        FieldTemp = Match2.Value
                                        FieldArry = Split(Match2.SubMatches(0), ",")
                                        If UBound(FieldArry) > 1 Then '参数正确,进行处理
                                            Select Case FieldArry(1)
                                            Case "Text" '按文本方式输出内容
                                                If rsLabelRe(PE_CLng(FieldArry(0))) = "" Or IsNull(rsLabelRe(PE_CLng(FieldArry(0)))) Then
                                                    FieldTempText = ""
                                                Else
                                                    If FieldArry(2) = 0 Then
                                                        Select Case FieldArry(3)
                                                        Case 1
                                                            FieldTempText = Replace(rsLabelRe(PE_CLng(FieldArry(0))), "<", "&lt;")
                                                        Case 2
                                                            FieldTempText = nohtml(rsLabelRe(PE_CLng(FieldArry(0))))
                                                        Case Else
                                                            FieldTempText = rsLabelRe(PE_CLng(FieldArry(0)))
                                                        End Select
                                                    Else
                                                        Select Case FieldArry(3)
                                                        Case 1
                                                            If FieldArry(4) = 0 Then
                                                                FieldTempText = GetSubStr(Replace(rsLabelRe(PE_CLng(FieldArry(0))), "<", "&lt;"), PE_CLng(FieldArry(2)), True)
                                                            Else
                                                                FieldTempText = GetSubStr(Replace(rsLabelRe(PE_CLng(FieldArry(0))), "<", "&lt;"), PE_CLng(FieldArry(2)), False)
                                                            End If
                                                        Case 2
                                                            If FieldArry(4) = 0 Then
                                                                FieldTempText = GetSubStr(nohtml(rsLabelRe(PE_CLng(FieldArry(0)))), PE_CLng(FieldArry(2)), True)
                                                            Else
                                                                FieldTempText = GetSubStr(nohtml(rsLabelRe(PE_CLng(FieldArry(0)))), PE_CLng(FieldArry(2)), False)
                                                            End If
                                                        Case Else
                                                            If FieldArry(4) = 0 Then
                                                                FieldTempText = GetSubStr(rsLabelRe(PE_CLng(FieldArry(0))), PE_CLng(FieldArry(2)), True)
                                                            Else
                                                                FieldTempText = GetSubStr(rsLabelRe(PE_CLng(FieldArry(0))), PE_CLng(FieldArry(2)), False)
                                                            End If
                                                        End Select
                                                    End If
                                                 End If
                                            Case "Num" '按数字方式输出内容
                                                If rsLabelRe(PE_CLng(FieldArry(0))) = "" Or IsNull(rsLabelRe(PE_CLng(FieldArry(0)))) Then
                                                    FieldTempText = "0"
                                                Else
                                                    Select Case FieldArry(2)
                                                    Case 0
                                                        If FieldArry(3) = "0" Then
                                                            FieldTempText = Int(rsLabelRe(PE_CLng(FieldArry(0))))
                                                        Else
                                                            FieldTempText = String(Int(rsLabelRe(PE_CLng(FieldArry(0)))), FieldArry(3))
                                                        End If
                                                    Case 1
                                                        FieldTempText = FormatNumber(rsLabelRe(PE_CLng(FieldArry(0))), FieldArry(3))
                                                    Case 2
                                                        FieldTempText = FormatPercent(rsLabelRe(PE_CLng(FieldArry(0))))
                                                    End Select
                                               End If
                                            Case "Time" '按时间方式输出内容
                                                Dim temptime, temptimetext
                                                If rsLabelRe(PE_CLng(FieldArry(0))) = "" Or IsNull(rsLabelRe(PE_CLng(FieldArry(0)))) Then
                                                    FieldTempText = ""
                                                Else
                                                    If IsDate(rsLabelRe(PE_CLng(FieldArry(0)))) Then '判断字段类型是否正确
                                                        temptime = rsLabelRe(PE_CLng(FieldArry(0)))