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> </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"> </td> </tr> <tr> <th align="left">作者</th> <td align="left">$author</td> <td align="left">Akon</td> <td align="left"> </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"> </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"> </td> </tr> <tr> <th align="left">函数调用</th> <td align="left">asp:CallFunction "标题:", "测试函数1"</td> <td align="left">标题:测试函数1</td> <td align="left">函数原型:<br /> <%<br /> Function CallFunction(title, body)<br /> response.Write title & body<br /> End Function<br /> %></td> </tr> <tr> <th align="left">直接输出</th> <td align="left">asp:="这里是ASP代码执行的结果!" </td> <td align="left">这里是ASP代码执行的结果!</td> <td align="left"> </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"> </td> </tr> <tr> <th align="left">URL传递</th> <td align="left">asp:=Request.QueryString("action") </td> <td align="left">hello</td> <td align="left"> </td> </tr> <tr> <th colspan="4" align="left"> </th> </tr> </table> <h1 align="center">这里是页面的底部</h1> </body> </html> |