ASP 高级模板引擎实现类_应用技巧_

Class template

    Private c_Char, c_Path, c_FileName, c_Content, c_PageUrl, c_CurrentPage, c_PageStr, ReplacePageStr
    Private TagName

    ' ***************************************
    '    设置编码
    ' ***************************************
    Public Property Let Char(ByVal Str)
        c_Char = Str
    End Property
    Public Property Get Char
        Char = c_Char
    End Property

    ' ***************************************
    '    设置模板文件夹路径
    ' ***************************************
    Public Property Let Path(ByVal Str)
        c_Path = Str
    End Property
    Public Property Get Path
        Path = c_Path
    End Property

    ' ***************************************
    '    设置模板文件名
    ' ***************************************
    Public Property Let FileName(ByVal Str)
        c_FileName = Str
    End Property
    Public Property Get FileName
        FileName = c_FileName
    End Property

    ' ***************************************
    '    获得模板文件具体路径
    ' ***************************************
    Public Property Get FilePath
        If Len(Path) > 0 Then Path = Replace(Path, "\", "/")
        If Right(Path, 1) <> "/" Then Path = Path & "/"
        FilePath = Path & FileName
    End Property

    ' ***************************************
    '    设置分页URL
    ' ***************************************
    Public Property Let PageUrl(ByVal Str)
        c_PageUrl = Str
    End Property
    Public Property Get PageUrl
        PageUrl = c_PageUrl
    End Property

    ' ***************************************
    '    设置分页 当前页
    ' ***************************************
    Public Property Let CurrentPage(ByVal Str)
        c_CurrentPage = Str
    End Property
    Public Property Get CurrentPage
        CurrentPage = c_CurrentPage
    End Property

    ' ***************************************
    '    输出内容
    ' ***************************************
    Public Property Get Flush
        Response.Write(c_Content)
    End Property

    ' ***************************************
    '    类初始化
    ' ***************************************
    Private Sub Class_Initialize
        TagName = "pjblog"
        c_Char = "UTF-8"
        ReplacePageStr = Array("", "")
    End Sub

    ' ***************************************
    '    过滤冲突字符
    ' ***************************************
    Private Function doQuote(ByVal Str)
        doQuote = Replace(Str, Chr(34), """)
    End Function

    ' ***************************************
    '    类终结
    ' ***************************************
    Private Sub Class_Terminate
    End Sub

    ' ***************************************
    '    加载文件方法
    ' ***************************************
    Private Function LoadFromFile(ByVal cPath)
        Dim obj
        Set obj = Server.CreateObject("ADODB.Stream")
            With obj
             .Type = 2
                .Mode = 3
                .Open
                .Charset = Char
                .Position = .Size
                .LoadFromFile Server.MapPath(cPath)
                LoadFromFile = .ReadText
                .close
            End With
        Set obj = Nothing
    End Function

    ' ***********************************************
    '    获取正则匹配对象
    ' ***********************************************
    Public Function GetMatch(ByVal Str, ByVal Rex)
        Dim Reg, Mag
        Set Reg = New RegExp
        With Reg
            .IgnoreCase = True
            .Global = True
            .Pattern = Rex
            Set Mag = .Execute(Str)
            If Mag.Count > 0 Then
                Set GetMatch = Mag
            Else
                Set GetMatch = Server.CreateObject("Scripting.Dictionary")
            End If
        End With
        Set Reg = nothing
    End Function

    ' ***************************************
    '    打开文档
    ' ***************************************
    Public Sub open
        c_Content = LoadFromFile(FilePath)
    End Sub

    ' ***************************************
    '    缓冲执行
    ' ***************************************
    Public Sub Buffer
        c_Content = GridView(c_Content)
        Call ExecuteFunction
    End Sub

    ' ***************************************
    '    GridView
    ' ***************************************
    Private Function GridView(ByVal o_Content)
        Dim Matches, SubMatches, SubText
        Dim Attribute, Content
        Set Matches = GetMatch(o_Content, "\<" & TagName & "\:(\d+?)(.+?)\>([\s\S]+?)<\/" & TagName & "\:\1\>")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                Attribute = SubMatches.SubMatches(1)     ' kocms
                Content = SubMatches.SubMatches(2)     ' ...
                SubText = Process(Attribute, Content)     ' 返回所有过程执行后的结果
                o_Content = Replace(o_Content, SubMatches.value, "<" & SubText(2) & SubText(0) & ">" & SubText(1) & "", 1, -1, 1)                                            ' 替换标签变量
            Next
        End If
        Set Matches = Nothing
        If Len(ReplacePageStr(0)) > 0 Then                ' 判断是否标签变量有值,如果有就替换掉.
            o_Content = Replace(o_Content, ReplacePageStr(0), ReplacePageStr(1), 1, -1, 1)
            ReplacePageStr = Array("", "")                ' 替换后清空该数组变量
        End If
        GridView = o_Content
    End Function

    ' ***************************************
    '    确定属性
    ' ***************************************
    Private Function Process(ByVal Attribute, ByVal Content)
        Dim Matches, SubMatches, Text
        Dim MatchTag, MatchContent
        Dim datasource, Name, Element, page, id
        datasource = "" : Name = "" : Element = "" : page = 0 : id = ""
        Set Matches = GetMatch(Attribute, "\s(.+?)\=\""(.+?)\""")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                MatchTag = SubMatches.SubMatches(0)                                ' 取得属性名
                MatchContent = SubMatches.SubMatches(1)                            ' 取得属性值
                If Lcase(MatchTag) = "name" Then Name = MatchContent            ' 取得name属性值
                If Lcase(MatchTag) = "datasource" Then datasource = MatchContent' 取得datasource属性值
                If Lcase(MatchTag) = "element" Then Element = MatchContent        ' 取得element属性值
                If Lcase(MatchTag) = "page" Then page = MatchContent            ' 取得page属性值
                If Lcase(MatchTag) = "id" Then id = MatchContent                ' 取得id属性值
            Next
            If Len(Name) > 0 And Len(MatchContent) > 0 Then
                Text = Analysis(datasource, Name, Content, page, id)            ' 执行解析属性
                If Len(datasource) > 0 Then Attribute = Replace(Attribute, "datasource=""" & datasource & """", "")
                If page > 0 Then Attribute = Replace(Attribute, "page=""" & page & """", "")
                Attribute = Replace(Attribute, "name=""" & Name & """", "", 1, -1, 1)
                Attribute = Replace(Attribute, "element=""" & Element & """", "", 1, -1, 1)
                Process = Array(Attribute, Text, Element)
            Else
                Process = Array(Attribute, "", "div")
            End If
        Else
            Process = Array(Attribute, "", "div")
        End If
        Set Matches = Nothing
    End Function

    ' ***************************************
    '    解析
    ' ***************************************
    Private Function Analysis(ByVal id, ByVal Name, ByVal Content, ByVal page, ByVal PageID)
        Dim Data
        Select Case Lcase(Name)                                                    ' 选择数据源
            Case "loop" Data = DataBind(id, Content, page, PageID)
            Case "for" Data = DataFor(id, Content, page, PageID)
        End Select
        Analysis = Data
    End Function

    ' ***************************************
    '    绑定数据源
    ' ***************************************
    Private Function DataBind(ByVal id, ByVal Content, ByVal page, ByVal PageID)
        Dim Text, Matches, SubMatches, SubText
        Execute "Text = " & id & "(1)"                                            ' 加载数据源
        Set Matches = GetMatch(Content, "\([\s\S]+)\<\/Columns\>")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                SubText = ItemTemplate(SubMatches.SubMatches(0), Text, page, PageID)' 执行模块替换
                Content = Replace(Content, SubMatches.value, SubText, 1, -1, 1)
            Next
            DataBind = Content
        Else
            DataBind = ""
        End If
        Set Matches = Nothing
    End Function

    ' ***************************************
    '    匹配模板实例
    ' ***************************************
    Private Function ItemTemplate(ByVal TextTag, ByVal Text, ByVal page, ByVal PageID)
        Dim Matches, SubMatches, SubMatchText
        Dim SecMa

提示： 本文由神整理自网络，如有侵权请联系本站删除！
本站声明：
1、本站所有资源均来源于互联网，不保证100%完整、不提供任何技术支持；
2、本站所发布的文章以及附件仅限用于学习和研究目的;不得将用于商业或者非法用途；否则由此产生的法律后果，本站概不负责！

上一篇：asp 自定义分段函数/求第N名成绩_数据库相关_

下一篇：ASP 常见的连接字符串写法(access2007)_ASP基础_