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)     ' <columns>...</columns>
                subtext = process(attribute, content)     ' 返回所有过程执行后的结果
                o_content = replace(o_content, submatches.value, "<" & subtext(2) & subtext(0) & ">" & subtext(1) & "</" & subtext(2) & ">", 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, "\<columns\>([\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 secmatch, secsubmatch
        dim i, temptext
        dim textlen, textleft, textright
        set matches = getmatch(texttag, "\<itemtemplate\>([\s\s]+)\<\/itemtemplate\>")
        if matches.count > 0 then
            for each submatches in matches
                submatchtext = submatches.submatches(0)
                ' ---------------------------------------------
                '    循环嵌套开始
                ' ---------------------------------------------
                submatchtext = gridview(submatchtext)
                ' ---------------------------------------------
                '    循环嵌套结束
                ' ---------------------------------------------
                if ubound(text, 1) = 0 then
                    temptext = ""
                else
                    temptext = ""
                    ' -----------------------------------------------
                    '    开始分页
                    ' -----------------------------------------------
                    if len(page) > 0 and page > 0 then
                        if len(currentpage) = 0 or currentpage = 0 then currentpage = 1
                        textlen = ubound(text, 2)
                        textleft = (currentpage - 1) * page
                        textright = currentpage * page - 1
                        if textleft < 0 then textleft = 0
                        if textright > textlen then textright = textlen
                        c_pagestr = multipage(textlen + 1, page, currentpage, pageurl, "float:right", "", false)

                        if int(len(c_pagestr)) > 0 then
                            replacepagestr = array("<page:" & trim(pageid) & "/>", c_pagestr)
                        else
                            replacepagestr = array("<page:" & trim(pageid) & "/>", "")
                        end if
                    else
                        textleft = 0
                        textright = ubound(text, 2)
                    end if

                    for i = textleft to textright
                        temptext = temptext & itemresec(i, submatchtext, text)        ' 加载模板内容
                    next
                end if
            next
            itemtemplate = temptext
        else
            itemtemplate = ""
        end if
        set matches = nothing
    end function

    ' ***************************************
    '    替换模板字符串
    ' ***************************************
    private function itemresec(byval i, byval text, byval arrays)
        dim matches, submatches
        set matches = getmatch(text, "\$(\d+?)")
        if matches.count > 0 then
            for each submatches in matches
                text = replace(text, submatches.value, doquote(arrays(submatches.submatches(0), i)), 1, -1, 1) '执行替换
            next
            itemresec = text
        else
            itemresec = ""
        end if
        set matches = nothing
    end function

    ' ***************************************
    '    全局变量函数
    ' ***************************************
    private sub executefunction
        dim matches, submatches, text, exetext
        set matches = getmatch(c_content, "\<function\:([0-9a-za-z_\.]*?)\((.*?)\""(.+?)\""(.*?)\)\/\>")
        if matches.count > 0 then
            for each submatches in matches
                text = submatches.submatches(0) & "(" & submatches.submatches(1) & """" & submatches.submatches(2) & """" & submatches.submatches(3) & ")"
                execute "exetext=" & text
                c_content = replace(c_content, submatches.value, exetext, 1, -1, 1)
            next
        end if
        set matches = nothing
    end sub

    ' ***************************************
    '    普通替换全局标签
    ' ***************************************
    public property let sets(byval t, byval s)
        dim setmatch, bstr, setsubmatch
        set setmatch = getmatch(c_content, "(\<set\:([0-9a-za-z_\.]*?)\(((.*?)" & t & "(.*?))?\)\/\>)")
        if setmatch.count > 0 then
            for each setsubmatch in setmatch
                execute "bstr = " & setsubmatch.submatches(1) & "(" & setsubmatch.submatches(3) & """" & s & """" & setsubmatch.submatches(4) & ")"
                c_content = replace(c_content, setsubmatch.value, bstr, 1, -1, 1)
            next
        end if
        set setmatch = nothing
        set setmatch = getmatch(c_content, "(\<set\:" & t & "\/\>)")
        if setmatch.count > 0 then
            for each setsubmatch in setmatch
                c_content = replace(c_content, setsubmatch.value, s, 1, -1, 1)
            next
        end if
        set setmatch = nothing
    end property

end class