自定义模板标签解析-优快云博客

文章栏目ID为17，共显示10条记录，每条记录最多显示10个字符，不比是精华，分两栏显示。本文章演示的是原理，根据这个原理可以实现更复杂的模板。一、定义模板 template.htm <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <title>模板</title> </head> <body> <table width="600" border="0" style="border:1px solid blue; font-size:12px"> <tr> <td>文章栏目ID为17，共显示10条记录，每条记录最多显示10个字符，不比是精华，分两栏显示</td> </tr> <tr> <td style="border:1px solid red; font-size:12px; "><tag:loop channelid="17" pagesize="10" title="10" elite="false" column="2"/></td> </tr> </table> <br> <table width="600" border="0" style="border:1px solid blue; font-size:12px"> <tr> <td>文章栏目ID为23，共显示8条记录，每条记录最多显示10个字符，不必是精华，不两栏显示</td> </tr> <tr> <td style="border:1px solid red; font-size:12px; "><tag:loop channelid="23" pagesize="8" title="10" elite="false" column="1"/></td> </tr> </table> </body> </html> 二、处理模板 Default.asp '【功能】处理自定义模板标签 Function ProcessCustomTags()Function ProcessCustomTags(ByVal sContent) Dim objRegEx, Match, Matches '建立正则表达式 Set objRegEx = New RegExp '查找内容 objRegEx.Pattern = "<tag:[^<>]+?//>" '忽略大小写 objRegEx.IgnoreCase = True '全局查找 objRegEx.Global = True 'Run the search against the content string we've been passed Set Matches = objRegEx.Execute(sContent) '循环已发现的匹配 For Each Match in Matches 'Replace each match with the appropriate HTML from our ParseTag function sContent = Replace(sContent, Match.Value, ParseTag(Match.Value)) Next '消毁对象 set Matches = nothing set objRegEx = nothing '返回值 ProcessCustomTags = sContent End Function '【功能】取得模板标签的参数名 '如：<tag:loop channelid="1" pagesize="10" title="20" type="NEW" column="1"> Function GetAttribute()function GetAttribute(ByVal strAttribute, ByVal strTag) Dim objRegEx, Matches '建立正则表达式 Set objRegEx = New RegExp '查找内容 (the attribute name followed by double quotes etc) objRegEx.Pattern = lCase(strAttribute) & "=""[0-9a-zA-Z]*""" '忽略大小写 objRegEx.IgnoreCase = True '全局查找 objRegEx.Global = True '执行搜索 Set Matches = objRegEx.Execute(strTag) '如有匹配的则返回值, 不然返回空值 if Matches.Count > 0 then GetAttribute = Split(Matches(0).Value,"""")(1) else GetAttribute = "" end if '消毁对象 set Matches = nothing set objRegEx = nothing end function '【功能】解析并替换相应的模板标签内容 Function ParseTag()function ParseTag(ByVal strTag) dim arrResult, ClassName, arrAttributes, sTemp, i, objClass '如果标签是空的则退出函数 if len(strTag) = 0 then exit function 'Split the match on the colon character (:) arrResult = Split(strTag, ":") 'Split the second item of the resulting array on the space character, to 'retrieve the name of the class ClassName = Split(arrResult(1), " ")(0) 'Use a select case statement to work out which class we're dealing with 'and therefore which properties to populate etc select case uCase(ClassName) 'It's a loop class, so instantiate one and get it's properties case "LOOP" set objClass = new WawaLoop objClass.Channelid= GetAttribute("channelid", strTag) objClass.Pagesize= GetAttribute("pagesize", strTag) objClass.title = GetAttribute("title", strTag) objClass.Elite = GetAttribute("elite", strTag) ParseTag =objClass.column (GetAttribute("column", strTag)) set objClass = nothing end select end function '【功能】实际替换标签的类 Class WawaLoopClass WawaLoop public Channelid,Pagesize,title,Elite,conn Private Sub Class_Initialize()Sub Class_Initialize() dim connstr dim db db="wawa.mdb" Set conn = Server.CreateObject("ADODB.Connection") connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db) conn.Open connstr End Sub Public Function column()Function column(strColumn) dim i,rs,sql,strtemp i = 1 strtemp = strtemp& "<table width=100% border=0>" strtemp = strtemp&"<tr>" set rs=server.CreateObject("adodb.recordset") sql = "select top "&Pagesize&" * from article where classid="&Channelid&" and Elite="&Elite&"" rs.open sql,conn,1,1 do while not rs.eof strtemp = strtemp& "<td valign=top>" &lefttrue(rs("title"),title) & "</td>" if (i mod strColumn) =0 then strtemp = strtemp& "</tr><tr>" end if rs.movenext i=i+1 loop rs.close:set rs = nothing strtemp = strtemp& "</table>" column = strtemp End Function End Class ’【功能】截断字符串的一个函数 Function LeftTrue()Function LeftTrue(str,n) If len(str)<=n/2 Then LeftTrue=str Else Dim TStr Dim l,t,c Dim i l=len(str) TStr="" t=0 for i=1 to l c=asc(mid(str,i,1)) If c<0 then c=c+65536 If c>255 then t=t+2 Else t=t+1 End If If t>n Then exit for TStr=TStr&(mid(str,i,1)) next LeftTrue = TStr & "" End If End Function Function ReadAllTextFile()Function ReadAllTextFile Const ForReading = 1 Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile(Server.MapPath("template.htm"), ForReading) ReadAllTextFile = f.ReadAll End Function '最后输出模板转换后的代码 response.write ProcessCustomTags(ReadAllTextFile)

ASP实现自定义标签模板