tagparser.class.asp

一个很好的asp cms管理系统

        Set Rs = Nothing

        Set regEx = Nothing
        Set Matches = Nothing
        TSYSTAG_Relate_List = strHtml
        Set strHtml = Nothing

    End Function

    '方法:分页列表 TSYS:pages_list(分页类型,'分页样式模板','当前页时的分页样式模板')
    '参数:Tsys标签
    '返回:分页列表Html字符串
    '说明:
    '   分页列表样式模板:便用用户定义个性化的分页列表效果
    '样式模板内部可用的动态变量有:
    '   $id$        资源id
    '   $title$     资源标题
    '   $title2$    资源标题2, 经过Html标签清除处理
    '   $title3$    资源标题3, 经过url编码、Html标签清除处理
    '   $url$       资源访问地址
    '   $page$      当前页号
    '   $addtime$   添加时间, {y}-{m}-{d}
    '   $addtime2$  添加时间2, {d}/{m}
    Private Function TSYSTAG_Pages_List(myFlag)

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

        TSYSTAG_Pages_List = ""

        Dim strTemplate, strTemplate_CurrPage, ListType
        If Matches.Count = 0 Then
            strTemplate = ""
            strTemplate_CurrPage = ""
        Else
            strTemplate = Trim(Matches(0).SubMatches(1))
            strTemplate_CurrPage = Trim(Matches(0).SubMatches(2))
            ListType = Matches(0).SubMatches(0)
        End If

        If strTemplate = "" Then
            strTemplate = "<a href=""$url$"" title=""$title2$"">[$page$]</a>&nbsp;"
        End If
        If strTemplate_CurrPage = "" Then
            strTemplate_CurrPage = "<a href=""$url$"" title=""$title2$""><b>[$page$]</b></a>&nbsp;"
        End If

        If RsInfo("pages_count") = 0 Then
            Set regEx = Nothing
            Set Matches = Nothing
            Exit Function
        End If

        Dim Sql, Rs, I, strHtml, tmpTitle, tmpTemplate, VisitUrl
        I = 1
        If RsInfo("pages_head") = -1 Then
            Sql = "SELECT TOP " & RsInfo("pages_count") & " id, title, visit_url, addtime FROM resource_list WHERE id=" & RsInfo("id") & " Or pages_head=" & RsInfo("id") & " ORDER BY pages_position"
        Else
            Sql = "SELECT TOP " & RsInfo("pages_count") & " id, title, visit_url, addtime FROM resource_list WHERE id=" & RsInfo("pages_head") & " Or pages_head=" & RsInfo("pages_head") & " ORDER BY pages_position"
        End If
        Set Rs = Db.ExeCute(Sql)
        While Not Rs.Eof

            If IsNull(Rs("visit_url")) Or Rs("visit_url") = "" Then
                VisitUrl = ""
            Else
                VisitUrl = Rs("visit_url")
            End If

            If Rs("id") = RsInfo("id") Then
                tmpTemplate = strTemplate_CurrPage
            Else
                tmpTemplate = strTemplate
            End If

            tmpTemplate = Replace(tmpTemplate, "$id$", Rs("id"))
            tmpTitle = Rs("title")
            tmpTemplate = Replace(tmpTemplate, "$title$", tmpTitle)
            tmpTitle = RegReplace("<.*?>", tmpTitle, "")
            tmpTemplate = Replace(tmpTemplate, "$title2$", tmpTitle)
            tmpTemplate = Replace(tmpTemplate, "$title3$", Server.UrlEncode(tmpTitle))
            tmpTemplate = Replace(tmpTemplate, "$url$", VisitUrl)
            tmpTemplate = Replace(tmpTemplate, "$page$", I)
            tmpTemplate = Replace(tmpTemplate, "$addtime$", FLib.FormatMyDate(Rs("addtime"), "{y}-{m}-{d}"))
            tmpTemplate = Replace(tmpTemplate, "$br$", "<br>")
            strHtml = strHtml & tmpTemplate
            I = I + 1
            Rs.MoveNext()
        Wend
        Rs.Close()
        Set Rs = Nothing

        If strHtml <> "" Then
            If ListType = "1" Then
                TSYSTAG_Pages_List = "<select onchange=""location=this.options[this.options.selectedIndex].value"">" & strHtml & "</option>"
            Else
                TSYSTAG_Pages_List = strHtml
            End If
        Else
            TSYSTAG_Pages_List = strHtml
        End If

        Set regEx = Nothing
        Set Matches = Nothing
        Set strHtml = Nothing

    End Function

    '方法:字符url编码 TSYS:urlencode(字符串)
    '参数:Tsys标签
    '返回:url编码后数据
    Private Function TSYSTAG_UrlEncode(myFlag)

        TSYSTAG_UrlEncode = ""
        If myFlag.Value = "" Or IsNull(myFlag.Value) Then
            Exit Function
        End If
        TSYSTAG_UrlEncode = Server.UrlEncode(myFlag.Value)

    End Function

    '方法:字符串截取函数 TSYS:left(字符串, 截取长度, '补给串')
    '参数:Tsys标签
    '返回:截取后字符串
    Private Function TSYSTAG_Left(myFlag)
        Dim regEx, Matches
        Set regEx = New RegExp
        regEx.IgnoreCase = False
        regEx.Global = False
        regEx.MultiLine = False
        regEx.Pattern = "([^\,]{0,}),[\s]{0,}([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'"
        Set Matches = regEx.Execute(myFlag.Value)

        TSYSTAG_Left = ""

        If Matches.Count > 0 Then
            If Len(Matches(0).SubMatches(0))<=CInt(Matches(0).SubMatches(1)) Then
                TSYSTAG_Left = Matches(0).SubMatches(0)
            Else
                TSYSTAG_Left = Left(Matches(0).SubMatches(0), Matches(0).SubMatches(1)) & Matches(0).SubMatches(2)
            End If
        End If

        Set regEx = Nothing
        Set Matches = Nothing
    End Function

    '方法:格式化时间格式 TSYS:format_date(时间, '时间格式串')
    '参数:Tsys标签
    '返回:截取后字符串
    Private Function TSYSTAG_Format_Date(myFlag)
        Dim regEx, Matches
        Set regEx = New RegExp
        regEx.IgnoreCase = true
        regEx.Global = True
        regEx.MultiLine = True
        regEx.Pattern = "([^\,]{0,})[\s]{0,},[\s]{0,}'([^']{0,})'"
        Set Matches = regEx.Execute(myFlag.value)
        Dim DateTemplate
            DateTemplate = "{Y}-{m}-{d}"
        TSYSTAG_Format_Date = ""
        If Matches.Count > 0 Then
            If Matches(0).SubMatches(1) <> "" Then
                DateTemplate = Matches(0).SubMatches(1)
            End If
            TSYSTAG_Format_Date = FLib.FormatMyDate(Matches(0).SubMatches(0), DateTemplate)
        Else
            TSYSTAG_Format_Date = myFlag.Value
        End If

        Set regEx = Nothing
        Set Matches = Nothing
    End Function

    '方法:清除html标签 TSYS:filter_html(字符串)
    '参数:Tsys标签
    '返回:清除后字符串
    Private Function TSYSTAG_FilterHtml(myFlag)

        TSYSTAG_FilterHtml = ""
        If myFlag.Value <> "" Or Not IsNull(myFlag.Value) Then
            TSYSTAG_FilterHtml = RegReplace("<.*?>", myFlag.Value, "")
        End If

    End Function

    '####### 系统预设标签库－结束 #############################################################################



    '####### 用户扩展标签库－开始 #############################################################################

    '方法:清除所有空格 TSYS:trim(字符串)
    '参数:Tsys标签
    '返回:清除后字符串
    Private Function USERTAG_TRIM(myFlag)
        USERTAG_TRIM = Trim(myFlag.Value)
    End Function

    '####### 用户扩展标签库－结束 #############################################################################

End Class

'#类名:标签对象
'#属性:
'       Name        标签名称
'       Value       标签括号内数据
Class TSYSFlagItem
    Public mName, mValue

    Public Function Init(ResColl, Name, Value)
        mName = Name
        mValue = Value

        If mValue = "" Then
            Exit Function
        End If

        Dim regEx, Matches, Match
        Set regEx = New RegExp
        regEx.IgnoreCase = False
        regEx.Global = False
        regEx.MultiLine = False
        regEx.Pattern = "(TSYSRES\#[\d]{1,10})"
        Set Matches = regEx.Execute(mValue)

        If Matches.Count = 0 Then
            Set regEx = Nothing
            Set Matches = Nothing
            Exit Function
        End If

        For Each Match In Matches
            mValue = Replace(mValue, Match.SubMatches(0), ResColl.Item(Match.SubMatches(0)))
        Next

        Set regEx = Nothing
        Set Matches = Nothing

    End Function

    Public Property Get Value()
        Value = mValue
    End Property

    Public Property Get Name()
        Name = mName
    End Property

    Private Sub Class_Terminate
    End Sub
End Class
%>