蛙蛙推荐：ASP实现自定义标签模板

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>

</head>

<body>

<tr>

<td>文章栏目ID为17，共显示10条记录，每条记录最多显示10个字符，不比是精华，分两栏显示</td>

</tr>

<tr>

</tr>

</table>

<br>

<tr>

<td>文章栏目ID为23，共显示8条记录，每条记录最多显示10个字符，不必是精华，不两栏显示</td>

</tr>

<tr>

</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))

'消毁对象

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 = nothing

end 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 select

end 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 Function

End 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))

LeftTrue = TStr & "

End If

End Function

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的，你几乎可以不加修改的转换为vb.net代码，呵呵，几乎就是修改一下FSO能力。根据这个原理，你就可以写一个支持多种模板和皮肤的网站了。虽然我们在前期开发的时候可能得费一些力气来编码，但这是值得的。

源码下载地址：
https://files.cnblogs.com/onlytiancai/AspCustomTag.rar