tagparser.class.asp

一个很好的asp cms管理系统

<%
'类名:TSYS标签库解析
'说明:
'   所有Tsys模板资源标签格式:
'           <!--TSYS:指令名([参数])-->
Class TagParser
    Private RsInfo, TempContent
    private ResColl, TParser

    '初始化类
    Private Sub Class_Initialize
        Set ResColl = Server.CreateObject(Cfg.Dictionary_Name)
    End Sub

    '注消类
    Private Sub Class_Terminate
        Set ResColl = Nothing
    End Sub

    '方法:
    Public Function Parser(Rs, Str)
        TempContent = Str
        Set RsInfo = Rs
        '开始解析
        TSYSTag_Parser()
        Parser = TempContent
    End Function

    '方法:资源模板内标签获取
    '参数:-
    '返回:-
    '说明:
    Private Function TSYSTag_Parser()

        Dim regEx, Matches, Match
        Set regEx = New RegExp
        regEx.IgnoreCase = False
        regEx.Global = True
        regEx.MultiLine = True
        regEx.Pattern = "\<\!\-\-TSYS\:(.*?)\-\-\>"
        Set Matches = regEx.Execute(TempContent)

        Dim strContent, tmpItem
        For Each Match In Matches
            If Match.SubMatches(0) <> "" Then
               strContent = TSYSTag_Parser2(Match.SubMatches(0))
               '将所有指令数据临时存储区内数据替换至指定位置
               For Each tmpItem In ResColl
                    strContent = Replace(strContent, tmpItem, ResColl.Item(tmpItem))
               Next
               '清空指令数据临时存储区
               ResColl.RemoveAll()
               '将最终标签的数据替换入资源模板
               TempContent = Replace(TempContent, Match.Value, strContent)
            End If
        Next

    End Function

    '方法:TSYS标签指令解析
    '参数:-
    '返回:解析后的套用模板后的资源内容
    '说明:
    '   读取所有标签指令,并提交相应程序处理
    Private Function TSYSTag_Parser2(strCommand)

        Dim regEx, Matches, Match
        Set regEx = New RegExp
        regEx.IgnoreCase = False
        regEx.Global = True
        regEx.MultiLine = True
        regEx.Pattern = "([a-z0-9_]{1,50})\(((?:(?![a-z0-9_]{1,50}\(.*?\)).)*?)\)"

        Set Matches = regEx.Execute(strCommand)
        If Matches.Count = 0 Then
            TSYSTag_Parser2 = strCommand
            Exit Function
        End If

        Dim tmpResName, myFlag
        Set myFlag = New TSYSFlagItem
        For Each Match In Matches
            '创建标签指令对象
            myFlag.Init ResColl, Match.SubMatches(0), Match.SubMatches(1)
            tmpResName = "TSYSRES#" & ResColl.Count
            '建立指令数据临时存储区, 并将标签指令解析完毕的数据暂存入此存储区内
            ResColl.Add tmpResName, TSYSTag_Parser_Switch(myFlag)
            '定义存储区数据在strCommand中的位置，以便最后替换更新
            strCommand = Replace(strCommand, Match.value, tmpResName)

        Next
        TSYSTag_Parser2 = TSYSTag_Parser2(strCommand)

    End Function

    '方法:TSYS资源模板标签处理入口
    '参数:标签正则对象
    '返回:处理后的数据
    '说明:
    '   根据标签名称调对应的标签处理程序
    Private Function TSYSTag_Parser_Switch(myFlag)
        Select Case myFlag.Name

            '----------------- // 系统定义标签处理入口引用头－开始 //
            Case "data"
                TSYSTag_Parser_Switch = TSYSTAG_Data_Field(myFlag)
            Case "relate_list"
                TSYSTag_Parser_Switch = TSYSTAG_Relate_List(myFlag)
            Case "pages_list"
                TSYSTag_Parser_Switch = TSYSTAG_Pages_List(myFlag)
            Case "format_date"
                TSYSTag_Parser_Switch = TSYSTAG_Format_Date(myFlag)
            Case "urlencode"
                TSYSTag_Parser_Switch = TSYSTAG_UrlEncode(myFlag)
            Case "left"
                TSYSTag_Parser_Switch = TSYSTAG_Left(myFlag)
            Case "filter_html"
                TSYSTag_Parser_Switch = TSYSTAG_FilterHtml(myFlag)
            '----------------- // 系统定义标签处理入口引用头－结束 //


            '----------------- // 自定义标签头引用头－开始 //
            Case "trim"
                TSYSTag_Parser_Switch = USERTAG_TRIM(myFlag)
            '----------------- // 自定义标签头引用头－结束 //

            '----------------- // 标签无法处理 //
            Case Else
                TSYSTag_Parser_Switch = "未找到TSYS资源模板标签:" & myFlag.Name

        End Select
    End Function

    '方法:正则串关键字符转义
    '参数:正则串
    '返回:转义后正则串
    Private Function TSYSTag_Parser_EscapePattern(Pattern)

        Pattern = Replace(Pattern, "\", "\\")
        Pattern = Replace(Pattern, "*", "\*")
        Pattern = Replace(Pattern, "[", "\[")
        Pattern = Replace(Pattern, "]", "\]")
        Pattern = Replace(Pattern, ".", "\.")
        Pattern = Replace(Pattern, ":", "\:")
        Pattern = Replace(Pattern, "(", "\(")
        Pattern = Replace(Pattern, ")", "\)")
        Pattern = Replace(Pattern, "?", "\?")
        Pattern = Replace(Pattern, "{", "\{")
        Pattern = Replace(Pattern, "}", "\}")
        Pattern = Replace(Pattern, ",", "\,")
        Pattern = Replace(Pattern, "+", "\+")
        Pattern = Replace(Pattern, "^", "\^")
        Pattern = Replace(Pattern, "$", "\$")
        Pattern = Replace(Pattern, "!", "\!")
        Pattern = Replace(Pattern, "-", "\-")
        TSYSTag_Parser_EscapePattern = Pattern

    End Function

    '方法:正则替换
    '参数:
    '   Pattern     正则表达式
    '   findStr     源字符串
    '   replaceStr  将替换的字符串
    '返回:替换后字符串
    Private Function RegReplace(Pattern, findStr, replaceStr)

        Dim regEx
        Set regEx = New RegExp
        regEx.IgnoreCase = True
        regEx.Global = True
        regEx.MultiLine = True
        regEx.Pattern = Pattern
        RegReplace = regEx.Replace(findStr, replaceStr)
        Set regEx = Nothing

    End Function


    '####### 系统预设标签库－开始 #############################################################################

    '方法:资源字段读取标签处理 TSYS:data(字段名)
    '参数:Tsys标签
    '返回:资源字段数据
    Private Function TSYSTAG_Data_Field(myFlag)

        TSYSTAG_Data_Field = ""
        If Trim(myFlag.Value) <> "" Or Not IsNull(myFlag.Value) Then
            TSYSTAG_Data_Field = RsInfo(Trim(myFlag.Value))
        End If

    End Function
    
    '方法:相关资源列表 TSYS:relate_list(数目, "相关列表样式模板")
    '参数:Tsys标签
    '返回:分页列表Html字符串
    '说明:
    '   相关列表样式模板:便用用户定义个性化的相关列表效果
    '样式模板内部可用的动态变量有:
    '   $id$            资源id
    '   $title$         资源标题
    '   $url$           资源访问地址
    '   $author$        作者
    '   $addtime$       添加时间
    '   $class_title$   频道名称
    '   $class_id$      频道id
    '   $class_url$     频道地址
    Private Function TSYSTAG_Relate_List(myFlag)

        Dim Relate_IdList
        Relate_IdList = RsInfo("relate_list")
        If IsNull(Relate_IdList) Or Relate_IdList = "" Then
            TSYSTAG_Relate_List = ""
            Exit Function
        End If

        Dim regEx, Matches
        Set regEx = New RegExp
        regEx.IgnoreCase = False
        regEx.Global = False
        regEx.MultiLine = False
        regEx.Pattern = "[\s]{0,}([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'"
        Set Matches = regEx.Execute(myFlag.value)

        TSYSTAG_Relate_List = ""

        Dim strTemplate, strTemplate2, TopNum
        strTemplate2 = ""
        If Matches.Count = 0 Then
            strTemplate = ""
            TopNum = 10
        Else
            strTemplate = Trim(Matches(0).SubMatches(1))
            TopNum = FLib.SafeSql(Matches(0).SubMatches(0))
        End If

        If strTemplate = "" Then
            strTemplate = "·<a href=""$url$"" target=""_blank"">$title$</a>&nbsp;<font color=""#808080"">[$addtime$]</font>$br$"
        End If

        Dim Sql, Rs, strHtml
        strHtml = ""
        Sql = "SELECT TOP " & TopNum & " id, title, author, visit_url,  addtime, class_title, class_id, home_url FROM view_resource WHERE id IN (" & Relate_IdList & ")"
        Set Rs = Db.ExeCute(Sql)
        While Not Rs.Eof
            strTemplate2 = Replace(strTemplate, "$id$", Rs("id"))
            strTemplate2 = Replace(strTemplate2, "$title$", Rs("title"))
            strTemplate2 = Replace(strTemplate2, "$url$", Rs("visit_url"))
            strTemplate2 = Replace(strTemplate2, "$author$", Rs("author"))
            strTemplate2 = Replace(strTemplate2, "$addtime$", FLib.FormatMyDate(Rs("addtime"), "{y}-{m}-{d}"))
            strTemplate2 = Replace(strTemplate2, "$class_title$", Rs("class_title"))
            strTemplate2 = Replace(strTemplate2, "$class_id$", Rs("class_id"))
            strTemplate2 = Replace(strTemplate2, "$class_url$", Rs("home_url"))
            strTemplate2 = Replace(strTemplate2, "$br$", "<br>")
            strHtml = strHtml & strTemplate2 & vbCrLf
            Rs.MoveNext()
        Wend
        Rs.Close()