ASP实现自定义标签模板_【我的天空】技术资源服务站

来源:百度文库 编辑:神马文学网 时间:2024/10/04 21:27:15
ASP实现自定义标签模板2008年06月27日 星期五 13:03

摘要:这不是一个新话题了,无论是asp还是asp.net,谁都想实现真正的数据和显示分离。今天下午弄了一下,实现了这个效果。大概过程就是美工人员来制作模板,然后模板里面可以使用一些自定义标签,最后由程序来加载模板并输出实际的加了内容的页面。比如说下面的自定义标签
就表示
文章栏目ID为17,共显示10条记录,每条记录最多显示10个字符,不比是精华,分两栏显示。本文章演示的是原理,根据这个原理可以实现更复杂的模板。

一、定义模板
template.htm

 

"http://www.w3.org/TR/html4/loose.dtd">



模板




   


   

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





   


   

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



二、处理模板
Default.asp


'【功能】处理自定义模板标签
Function ProcessCustomTags()Function ProcessCustomTags(ByVal sContent)
         Dim objRegEx, Match, Matches
      '建立正则表达式
         Set objRegEx = New RegExp
      '查找内容
         objRegEx.Pattern = "]+?\/>"
      '忽略大小写
         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

'【功能】取得模板标签的参数名
'如:
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& "

"
strtemp = strtemp&""
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& ""
if (i mod strColumn) =0 then
   strtemp = strtemp& ""
end if
rs.movenext
i=i+1
loop
rs.close:set rs = nothing
strtemp = strtemp& "
" &lefttrue(rs("title"),title) & "
"
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的,你几乎可以不加修改的转换为vb.net代码,呵呵,几乎就是修改一下FSO能力。根据这个原理,你就可以写一个支持多种模板和皮肤的网站了。虽然我们在前期开发的时候可能得费一些力气来编码,但这是值得的。