|
ASP實(shí)現(xiàn)自定義標(biāo)簽?zāi)０?/STRONG>
一、定義模板
 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www./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個(gè)字符，不比是精華，分兩欄顯示</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個(gè)字符，不必是精華，不兩欄顯示</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>
二、處理模板  ‘【功能】處理自定義模板標(biāo)簽  Function ProcessCustomTags()Function ProcessCustomTags(ByVal sContent) Dim objRegEx, Match, Matches ‘建立正則表達(dá)式 Set objRegEx = New RegExp ‘查找內(nèi)容 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) ‘循環(huán)已發(fā)現(xiàn)的匹配 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  ‘【功能】取得模板標(biāo)簽的參數(shù)名 ‘如：<tag:loop channelid="1" pagesize="10" title="20" type="NEW" column="1">  Function GetAttribute()function GetAttribute(ByVal strAttribute, ByVal strTag) Dim objRegEx, Matches ‘建立正則表達(dá)式 Set objRegEx = New RegExp ‘查找內(nèi)容 (the attribute name followed by double quotes etc)  objRegEx.Pattern = lCase(strAttribute) & "=""[0-9a-zA-Z]*""" ‘忽略大小寫 objRegEx.IgnoreCase = True ‘全局查找 objRegEx.Global = True ‘執(zhí)行搜索 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  ‘【功能】解析并替換相應(yīng)的模板標(biāo)簽內(nèi)容  Function ParseTag()function ParseTag(ByVal strTag) dim arrResult, ClassName, arrAttributes, sTemp, i, objClass ‘如果標(biāo)簽是空的則退出函數(shù) 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 ‘【功能】實(shí)際替換標(biāo)簽的類  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 ’【功能】截?cái)嘧址囊粋€(gè)函數(shù)  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 ‘最后輸出模板轉(zhuǎn)換后的代碼 response.write ProcessCustomTags(ReadAllTextFile) 三、最終效果
小節(jié)：這里演示的語法是ASP的，你幾乎可以不加修改的轉(zhuǎn)換為vb.net代碼，呵呵，幾乎就是修改一下FSO能力。根據(jù)這個(gè)原理，你就可以寫一個(gè)支持多種模板和皮膚的網(wǎng)站了。雖然我們在前期開發(fā)的時(shí)候可能得費(fèi)一些力氣來編碼，但這是值得的。 源碼下載地址： |
|
|
