ASP实现自定义标签模板
摘要：这不是一个新话题了，无论是asp还是asp.net，谁都想实现真正的数据和显示分离。今天下午弄了一下，实现了这个效果。大概过程就是美工人员来制作模板，然后模板里面可以使用一些自定义标签，最后由程序来加载模板并输出实际的加了内容的页面。比如说下面的自定义标签
<tag:loop channelid="17" pagesize="10" title="10" elite="false" column="2"/>就表示
文章栏目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(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(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 = nothingend function'【功能】解析并替换相应的模板标签内容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 selectend function'【功能】实际替换标签的类Class WawaLoop public Channelid,Pagesize,title,Elite,conn
Private 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(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 FunctionEnd Class'【功能】截断字符串的一个函数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 FunctionFunction ReadAllTextFile Const ForReading = 1 Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile(Server.MapPath("template.htm"), ForReading) ReadAllTextFile = f.ReadAllEnd Function'最后输出模板转换后的代码response.write ProcessCustomTags(ReadAllTextFile) 三、最终效果
小节：这里演示的语法是ASP的，你几乎可以不加修改的转换为vb.net代码，呵呵，几乎就是修改一下FSO能力。根据这个原理，你就可以写一个支持多种模板和皮肤的网站了。虽然我们在前期开发的时候可能得费一些力气来编码，但这是值得的。
源码下载地址：
https://files.cnblogs.com/onlytiancai/AspCustomTag.rar