当前位置:96看吧 > 技术文档 > ASP编程 > ASP函数生成HTML模板的类

ASP函数生成HTML模板的类

时间:2009/12/24
作者:佚名
来源:96看吧
查看:
标签:asp函数

Class类文件代码:

<%
'==================================
'  ASP函数生成HTML模板的类
'==================================
Class Template
    Private ObjFso, ObjStream, ObjDict, FP
    Private TplCharset, TplDirectory, TplCompilerDirectory, TplLeftLimit, TplRightLimit, TplInitializeScript, TplCacheLimit, TplErrorReload
    Private ScriptBeginTime
    '初始化类
    Private Sub Class_Initialize()
        ScriptBeginTime = Timer()
        Set ObjFso = Server.CreateObject("Scripting.FileSystemObject")
        Set ObjDict = Server.CreateObject("Scripting.Dictionary")
        TplCharset = "utf-8"
        TplDirectory = "templates/"
        TplCompilerDirectory = "compiler/"
        TplLeftLimit = "{"
        TplRightLimit = "}"
        TplInitializeScript = "includes/init.inc.asp"
        TplCacheLimit = 30
        TplErrorReload = False
    End Sub
    '设置模板编码
    Public Property Let Charset(ByVal StrVal)
        TplCharset = StrVal
    End Property
    '设置模板所在目录
    Public Property Let TemplateDir(ByVal StrVal)
        TplDirectory = StrVal
    End Property
    '设置编译后的文件所在目录
    Public Property Let CompilerDir(ByVal StrVal)
        TplCompilerDirectory = StrVal
    End Property
    '设置变量标签左起始符
    Public Property Let LeftLimit(ByVal StrVal)
        TplLeftLimit = StrVal
    End Property
    '设置变量标签右起始符
    Public Property Let RightLimit(ByVal StrVal)
        TplRightLimit = StrVal
    End Property
    '设置程序初始化文件
    Public Property Let InitScript(ByVal StrVal)
        TplInitializeScript = StrVal
    End Property
    '设置文件缓存的时间
    Public Property Let CacheLimit(ByVal StrVal)
        TplCacheLimit = StrVal
    End Property
    '设置遇到错误是否重新创建编译文件
    Public Property Let ErrorReload(ByVal StrVal)
        TplErrorReload = Cbool(StrVal)
    End Property
    '变量解板
    Public Function Assign(ByVal Key, ByVal Value)
        If IsNull(Value) Then
            ObjDict(Key) = ""
        Else
            ObjDict(Key) = Value
        End If
    End Function
    '载入文件
    Private Function LoadFile(ByVal TplFile)
        On Error Resume Next
        Dim TempateFile
        Set ObjStream = Server.CreateObject("Adodb.Stream")
        TempateFile = Server.MapPath(TplDirectory & TplFile)
        With ObjStream
            .Type = 2
            .Mode = 3
            .Open
            .Charset = TplCharset
            .Position = ObjStream.Size
            .LoadFromFile TempateFile
            LoadFile = .ReadText
            .Close
        End With
        If Err.Number<>0 Then
            LoadFile = Error("Unable to read resource: """ & TplDirectory & TplFile & """.", False)
            Err.Clear
        End If
        Set ObjStream = Nothing
    End Function
    '编译模板
    Private Function Compiler(ByVal TplFile)
        Dim Contents
        Contents = LoadFile(TplFile)
        Dim RegExp, LeftLimit, RightLimit
        Set RegExp = New RegExp
        RegExp.IgnoreCase = True
        RegExp.Global = True
        '插入文件
        Dim Matches, I
        RegExp.Pattern = "([/|.|+|(|)|{|}|[|]|\^|\$|!|])"
        LeftLimit = RegExp.Replace(TplLeftLimit, "\$1")
        RightLimit = RegExp.Replace(TplRightLimit, "\$1")
        RegExp.pattern = LeftLimit & "include file=""(.+?)""" & RightLimit
        Set Matches = RegExp.Execute(Contents)
        For I=0 To Matches.Count-1
            Contents = Replace(Contents, Matches(I), LoadFile(Matches(I).SubMatches(0)))
        Next
        '变量替换
        Dim AllItems, K
        AllItems = ObjDict.Keys
        For Each K In AllItems
            Contents = Replace(Contents, TplLeftLimit & "$" & K & TplRightLimit, ObjDict(K))
        Next
        '编译ASP代码段
        RegExp.pattern = LeftLimit & "asp:(.+)" & RightLimit
        Set Matches = RegExp.Execute(Contents)
        For I=0 To Matches.Count-1
            Contents = Replace(Contents, Matches(I), "<%" &  Matches(I).SubMatches(0) & "%\>")
        Next
        Compiler = Contents
        Set RegExp = Nothing
        Set Matches = Nothing
    End Function
    '取得编译后的内容
    Public Function Fetch(ByVal TplFile)
        '设置初始化文件路径
        Dim RegExp, Matches, I, FilePath
        Set RegExp = New RegExp
        RegExp.Global = True
        RegExp.pattern = "\/"
        Set Matches = RegExp.Execute(TplCompilerDirectory)
        FilePath = ""
        For I=0 To Matches.Count-1
            FilePath = FilePath & "../"
        Next
        Set RegExp = Nothing
        Set Matches = Nothing
        '设置编译文件的内容及添加注释
        Fetch = "<!--#include file=""" & FilePath & TplInitializeScript & """ -->"  & Compiler(TplFile)
        Fetch = Fetch & vbcrlf & "<!-- Script Run time: " & (timer() - ScriptBeginTime) & " -->"
    End Function
    '写入编译后的文件
    Private Function WriteFile(ByVal TplFile)
        '检测目录是否存在,否则创建
        If Instr(TplCompilerDirectory, "/")<>0 Then
            Dim Folders, FolderName, CurrFolder
            Folders = Split(TplCompilerDirectory, "/")
            CurrFolder = ""
            For Each FolderName In Folders
                CurrFolder = CurrFolder & "\" & FolderName
                If Not ObjFso.FolderExists(Server.Mappath(".") & CurrFolder) Then
                    ObjFso.CreateFolder(Server.Mappath(".") & CurrFolder)
                End If
            Next
        Else
            Folder = Server.Mappath(TplCompilerDirectory)
            If Not ObjFso.FolderExists(Folder) Then ObjFso.CreateFolder(Folder)
        End if
        '写入到文件
        Set ObjStream = Server.CreateObject("Adodb.Stream")
        With ObjStream
            .Type = 2
            .Open
            .Charset = TplCharset
            .Position = ObjStream.Size
            .WriteText = Fetch(TplFile)
            .SaveToFile Server.MapPath(TplCompilerDirectory & ObjFso.GetBaseName(TplFile) & ".asp"), 2
            .Close
        End With
        Set ObjStream = Nothing
    End Function
    '缓存模板
    Private Function Cache(ByVal TplFile)
        Dim CompilerFile, FileInfo, CompilerBody
        CompilerFile = TplCompilerDirectory & ObjFso.GetBaseName(TplFile) & ".asp"
        '如果文件不存在则创建
        If Not ObjFso.FileExists(Server.MapPath(CompilerFile)) Then WriteFile(TplFile)
        '超过缓存时间, 重新创建
        Set FileInfo = ObjFso.GetFile(Server.MapPath(CompilerFile))
        if (DateDiff("s", FileInfo.DateLastModified, Now))>TplCacheLimit Then WriteFile(TplFile)
        Set FileInfo = Nothing
        '如果编译文件是否存在错误, 重新创建
        If TplErrorReload Then
            Set ObjStream = Server.CreateObject("Adodb.Stream")
            With ObjStream
                .Type = 2
                .Mode = 3
                .Open
                .Charset = TplCharset
                .Position = ObjStream.Size
                .LoadFromFile Server.MapPath(CompilerFile)
                CompilerBody = .ReadText
                .Close
            End With
            If (Instr(CompilerBody, "<strong>Template Error:</strong>")) Then WriteFile(TplFile)
            Set ObjStream = Nothing
        End If
    End Function
    '显示文件
    Public Function Display(ByVal TplFile)
        Cache(TplFile)
        Server.Transfer(TplCompilerDirectory & ObjFso.GetBaseName(TplFile) & ".asp")
    End Function
    '返回错误信息
    Private Function Error(String, IsEnd)
        Error = "<strong>Template Error:</strong> " & String
        If IsEnd Then Response.End()
    End Function
    '类结束
    Private Sub Class_Terminate()
        Set ObjFso = Nothing
        Set ObjDict = Nothing
    End Sub
End Class
%>

使用方法:

<%
Dim Tpl
Set Tpl = New Template
Tpl.Charset = "utf-8" '定义文件编码格式
Tpl.TemplateDir = "templates/" '定义模板文件所在目录
Tpl.CompilerDir = "compiler/" '定义模板编译文件所在目录
Tpl.LeftLimit = "{" '定义变量标签左起始符
Tpl.RightLimit = "}" '定义变量标签右起始符
Tpl.InitScript = "includes/init.inc.asp" '定义页初始化文件
Tpl.CacheLimit = 30 '定义编译文件缓存的时间, 单位秒
Tpl.ErrorReload = True '遇到错误是否重新创建编译文件, 将会比较占用资源
Tpl.Assign "headerinfo", "这里是页面的顶部"
Tpl.Assign "author", "Akon"
Tpl.Assign "url", "<a href=""http://www.96kb.com/"" target=""_blank"" title=""96看吧"">http://www.96kb.com/</a>"
Tpl.Assign "footerinfo", "这里是页面的底部"
Tpl.Display("test.htm") '输出模板
Set Tpl = Nothing
%>

HTML模板例子:

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>这里是页面的顶部</title>
<style type="text/css">
<!--
body,th,td {background: #f8f8f8;color:#000;font:12px "Courier New", Courier, monospace;}
th {font-size:14px;font-weight:bold}
-->
</style></head>
<body>
<h1 align="center">这里是页面的顶部</h1>
<table border="1" align="center" cellpadding="3" cellspacing="1" bordercolor="#999999" bgcolor="#FFFFFF">
  <tr>
    <th>&nbsp;</th>
    <th>变量</th>
    <th>结果</th>
    <th>说明</th>
  </tr>
  <tr>
    <th align="left">页面标题</th>
    <td align="left">$headerinfo</td>
    <td align="left">这里是页面的顶部</td>
    <td align="left">&nbsp;</td>
  </tr>
  <tr>
    <th align="left">作者</th>
    <td align="left">$author</td>
    <td align="left">Akon</td>
    <td align="left">&nbsp;</td>
  </tr>
  <tr>
    <th align="left">网址</th>
    <td align="left">$url</td>
    <td align="left"><a href="http://www.tblog.com.cn/" target="_blank" title="番茄's Blog">http://www.tblog.com.cn/</a></td>
    <td align="left">&nbsp;</td>
  </tr>
  <tr>
    <th align="left">未赋值变量</th>
    <td align="left">$test</td>
    <td align="left">{$test}</td>
    <td align="left">没有赋值,将不被解析</td>
  </tr>
  <tr>
    <th align="left">ASP代码断执行</th>
    <td align="left">asp:Response.Write "这里是ASP代码执行的结果!" </td>
    <td align="left">这里是ASP代码执行的结果!</td>
    <td align="left">&nbsp;</td>
  </tr>
  <tr>
    <th align="left">函数调用</th>
    <td align="left">asp:CallFunction "标题:", "测试函数1"</td>
    <td align="left">标题:测试函数1</td>
    <td align="left">函数原型:<br />
&lt;%<br />
Function CallFunction(title, body)<br />
&nbsp;&nbsp;
response.Write title & body<br />
End Function<br />
%&gt;</td>
  </tr>
  <tr>
    <th align="left">直接输出</th>
    <td align="left">asp:="这里是ASP代码执行的结果!" </td>
    <td align="left">这里是ASP代码执行的结果!</td>
    <td align="left">&nbsp;</td>
  </tr>
  <tr>
    <th align="left">执行条件语句</th>
    <td align="left">asp:Dim str<br />
      asp:str = true <br />
      asp:if str = true then <br />
      asp:="条件成立"<br />
      asp:else<br />
      asp:="条件不成立"<br />
      asp:end if </td>
    <td align="left">条件成立
    </td>
    <td align="left">&nbsp;</td>
  </tr>
  <tr>
    <th align="left">URL传递</th>
    <td align="left">asp:=Request.QueryString("action") </td>
    <td align="left">hello</td>
    <td align="left">&nbsp;</td>
  </tr>
  <tr>
    <th colspan="4" align="left">&nbsp;</th>
  </tr>
</table>
<h1 align="center">这里是页面的底部</h1>
</body>
</html>

 

上一篇:asp函数防止网页频繁刷新
下一篇:asp无组件中文验证码
页面举报
Report
关闭页面
Close
收藏页面
Favorites
分享页面
Share
版权信息:栏目内,站内会员所分享的全部“资源/素材/文章”,仅供学习与参考,版权为原作者所有。
下载提示:非注册用户每天可下载一个文件,已注册会员不受限制。
网友评论
数据载入中
验证码
  • 请您注意:
  • ·请不要在评论中含与内容无关的广告链接。
  • ·不良评论请用报告管理员,以利管理员及时删除。
  • ·遵守中华人民共和国的各项有关法律法规
  • ·承担一切因您的行为而直接或间接导致的民事或刑事法律责任
  • ·本站管理人员有权保留或删除评论中的任意内容
  • ·您在本站发表的作品,本站有权在网站内转载或引用
  • ·参与本评论即表明您已经阅读并接受上述条款
相关最新
相关热门