您现在的位置：雨哲在线 >> 文章教程 >> Web开发 >> Asp编程 >> 查看文章内容

ASP模板引擎代码

【字体：小大】热 ★★★ 作者：佚名文章来源：本站原创点击数：499 更新时间：2008-06-29 阅读点数：0点

载入中

复制内容到剪贴板

雨[http://www.yz81.com]65031哲提示：代码片段

<%
Class Cls_System
Dim Reg
Dim Code
Dim Page
Dim Rule
Dim Content
Dim Template
Dim Cachetime
Dim DefCachetime
Private Sub Class_Initialize()
Set Reg = New RegExp
Reg.Ignorecase = True
Reg.Global = True
Code = "GB2312"
Page = 0
Rule = ""
Content = ""
Template = ""
Cachetime = 0
DefCachetime = Cachetime
End Sub
Private Sub Class_Terminate()
Set Reg = Nothing
End Sub
Public Function Parser(Byval Templatefile)
Template = Templatefile
If ChkCache(Template) Then Parser = GetCache(Template) : Exit Function
If Not IsNumeric(Page) Then Page = 0 Else Page = Int(Page)
Loadfile
Parser_my
Parser_Sys
Parser_Com
Parser_Com
Parser_IF
SetCache Template,Content
Parser = Content
End Function
Public Function Parser_Sys()
On Error Resume Next
Dim Matche,SysValue
Reg.Pattern = "{Sys:([\s\S]*?)}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
If Len(Replace(Match.SubMatches(0)," ","")) > 0 Then Execute("SysValue = " & Replace(Match.SubMatches(0)," ","")) Else SysValue = ""
Content = Replace(Content, Match.Value, SysValue) '# 替换
If Err Then Err.Clear : Response.Write "<font color=red>执行变量标签失败[" & AspArr(i) & "]</font>" : Response.End
Next
End Function
Public Function Parser_My()
On Error Resume Next
Dim Rs,Ns,i
Set Rs = DB("Select [Name],[Code] From [5U_Label]",1)
If Not Rs.Eof Then Set Ns = Rs.Getrows()
Dim Matche,MyValue
Reg.Pattern = "{My:([\s\S]*?)}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
If Not Rs.Eof Then
If Len(Replace(Match.SubMatches(0)," ","")) > 0 Then
MyValue = Replace(Match.SubMatches(0)," ","")
For i = 0 To Ubound(Ns,2)
If Lcase(Ns(0,i)) = Lcase(Replace(Match.SubMatches(0)," ","")) Then MyValue = Ns(1,i) : Exit For
Next
End If
Else
MyValue = ""
End If
Content = Replace(Content, Match.Value, MyValue) '# 替换
If Err Then Err.Clear : Response.Write "<font color=red>执行自定义标签失败[" & AspArr(i) & "]</font>" : Response.End
Next
Rs.Close
Set Rs = Nothing
End Function
Public Function Parser_Com()
On Error Resume Next
Dim Rs,i,j
Dim Matche,BackValue
Dim Tagsstr,Loopstr
Dim Tag_Cache,Tag_Row,Tag_Col,Tag_Width,Tag_Sql,Tag_From,Tag_Where,Tag_Order
Reg.Pattern = "([\s\S]*?)"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
Cachetime = DefCachetime
Tagsstr = Match.SubMatches(1)
Loopstr = Match.SubMatches(2)
Tag_Cache = GetAttr(Tagsstr,"cache")
Tag_Row = GetAttr(Tagsstr,"row")
Tag_Col = GetAttr(Tagsstr,"col")
Tag_Width = GetAttr(Tagsstr,"width")
Tag_Sql = GetAttr(Tagsstr,"sql")
Tag_From = GetAttr(Tagsstr,"from")
Tag_Where = GetAttr(Tagsstr,"where")
Tag_Order = GetAttr(Tagsstr,"order")
If Len(Tag_Cache) = 0 Or Not IsNumeric(Tag_Cache) Then Tag_Cache = Cachetime
If Len(Tag_Row) = 0 Or Not IsNumeric(Tag_Row) Then Tag_Row = 10
If Int(Tag_Row) < 1 Then Tag_Row = 1
If Len(Tag_Col) = 0 Or Not IsNumeric(Tag_Col) Then Tag_Col = 1
If Int(Tag_Col) < 1 Then Tag_Col = 1
If Len(Tag_Width) = 0 Then Tag_Width = "100%"
If Len(Tag_Sql) < 5 Then
If Len(Tag_From) = 0 Then Tag_From = "5U_Content" '# 默认表
If Len(Tag_Where) > 0 Then Tag_Where = " Where " & Tag_Where '# 条件
If Len(Tag_Order) > 0 Then Tag_Order = " Order By " & Tag_Order '# 条件
Tag_Sql = "Select Top " & Tag_Row & " * From " & Tag_From & Tag_Where & Tag_Order
End If
Tag_Cache = Int(Tag_Cache)
Tag_Row = Int(Tag_Row)
Tag_Col = Int(Tag_Col)
Cachetime = Tag_Cache
If ChkCache(Tag_Sql) Then
BackValue = GetCache(Tag_Sql)
Else
BackValue = ""
If Page = 0 Then
Set Rs = DB(Tag_Sql,1)
Else
Set Rs = DB(Tag_Sql,3)
Rs.PageSize = Tag_Row * Tag_Col
Rs.AbsolutePage = Page
End If
If Tag_Col > 1 Then BackValue = BackValue & "<table width=""" & Tag_Width & """ border=""0"" cellpadding=""0"" cellspacing=""0"">" & Vbcrlf : j = 0
For i = 1 to Tag_Row * Tag_Col
If Rs.Eof Then Exit For '# 不存在记录就退出
j = j + 1
If Tag_Col > 1 Then
If j = 1 Then BackValue = BackValue & " <tr>" & Vbcrlf
BackValue = BackValue & " <td>"
End If
BackValue = BackValue & Parser_Tags("\[field:(.+?)\]",Loopstr,Rs)
If Tag_Col > 1 Then
BackValue = BackValue & " </td>" & Vbcrlf
If j = Tag_Col Then BackValue = BackValue & " </tr>" & Vbcrlf : j = 0
End If
Rs.MoveNext
Next
If Tag_Col > 1 Then
If j < Tag_Col And j > 0 Then
For i = 1 To Tag_Col - J
BackValue = BackValue & " <td></td>" & Vbcrlf
Next
BackValue = BackValue & " </tr>" & Vbcrlf
End If
BackValue = BackValue & "</table>" & Vbcrlf
End If
If Page >= 1 Then RegReplace "{tag:pagelist}",PageListX(Rs.PageCount,Rs.RecordCount,Page,Tag_Row * Tag_Col,Rule)
Rs.Close
SetCache Tag_Sql,BackValue
End If
Content = Replace(Content, Match.Value, BackValue)
Next
End Function
Public Function Parser_Tags(Byval Pattern,Byval Temp,Byval Dat)
Dim Matche
Dim Tagsstr,Tagsval,Tagsvalt
Dim Tag_Len,Tag_Lenext,Tag_Format,Tag_Replace,Tag_Clearhtml
Dim Re,Re1,Re2
Dim i,c,l
Reg.Pattern = Pattern
Set Matches = Reg.Execute(Temp)
For Each Match In Matches
Tagsstr = Match.SubMatches(0)
Tag_Len = GetAttr(Tagsstr,"len")
Tag_Lenext = GetAttr(Tagsstr,"lenext")
Tag_Format = GetAttr(Tagsstr,"format")
Tag_Replace = GetAttr(Tagsstr,"replace")
Tag_Clearhtml = GetAttr(Tagsstr,"clearhtml")
Tagsval = Split(Tagsstr," ")(0)
Tagsval = Dat(Tagsval)
Tagsval = Replace(Replace(Replace(Replace(Tagsval," "," "),""",chr(34)),">",">"),"<","<")
If Len(Replace(Tag_Replace," ","")) > 0 Then
Re = Split(Tag_Replace,"##")
If Ubound(Re) >= 0 Then Re1 = Re(0) : Re2 = Re(1) Else Re1 = Re(0): Re2 = Re(0)
Tagsval = Replace(Tagsval,Re1,Re2)
End If
If Len(Replace(Tag_Format," ","")) > 0 Then '# 格式化时间
If IsDate(Tagsval) Then
Tagsvalt = Tagsval : Tagsvalt = Lcase(Tag_Format)
Tagsvalt = Replace(Tagsvalt,"yyyy",Year(Tagsval)) : Tagsvalt = Replace(Tagsvalt,"yy",Right(Year(Tagsval),2))
Tagsvalt = Replace(Tagsvalt,"mm",Right("0" & Month(Tagsval),2)) : Tagsvalt = Replace(Tagsvalt,"m",Month(Tagsval))
Tagsvalt = Replace(Tagsvalt,"dd",Right("0" & Day(Tagsval),2)) : Tagsvalt = Replace(Tagsvalt,"d",Day(Tagsval))
Tagsvalt = Replace(Tagsvalt,"hh",Right("0" & Hour(Tagsval),2)) : Tagsvalt = Replace(Tagsvalt,"h",Hour(Tagsval))
Tagsvalt = Replace(Tagsvalt,"nn",Right("0" & Minute(Tagsval),2)) : Tagsvalt = Replace(Tagsvalt,"n",Minute(Tagsval))
Tagsvalt = Replace(Tagsvalt,"ss",Right("0" & Second(Tagsval),2)) : Tagsvalt = Replace(Tagsvalt,"s",Second(Tagsval))
Tagsval = Tagsvalt
End If
End If
If Lcase(Replace(Tag_Clearhtml," ","")) = "true" Then
Reg.Pattern = "(\<.+?\>)"
Tagsval = Reg.Replace(Tagsval, " ")
Tagsval = Trim(Tagsval)
End If
Tag_Len = Replace(Tag_Len," ","")
If Len(Tag_Len) > 0 And IsNumeric(Tag_Len) Then
For i = 1 To Len(Tagsval)
c = Abs(Asc(Mid(str,i,1)))
If c > 255 Or c < 1 Then t = t + 2 Else t = t + 1
If t >= Tag_Len then Tagsval = Left(Tagsval, i) & Tag_Lenext : Exit For
Next
End If
Temp = Replace(Temp, Match.Value, Tagsval)
Next
Parser_Tags = Temp
End Function
Public Function Parser_IF()
On Error Resume Next
Dim TestIF
Reg.Pattern = "{If:(.+?)}([\s\S]*?){Else}([\s\S]*?){End}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
Execute("If" & Match.SubMatches(0) & " Then TestIf = True Else TestIf = False")
If TestIf Then Content = Replace(Content, Match.Value, Match.SubMatches(1)) Else Content = Replace(Content, Match.Value, Match.SubMatches(2)) '# 替换
If Err Then Err.Clear : Response.Write "<font color=red>执行IF标签失败[" & Match.SubMatches(0) & "]</font>" : Response.End
Next
End Function
Public Function RegReplace(Byval Pattern,Byval ReplaceVal)
Reg.Pattern = Pattern
Set Matches = Reg.Execute(Content)
For Each Match In Matches
Content = Replace(Content, Match.Value, ReplaceVal)
Next
End Function
Public Function GetAttr(Byval Tagsstr,Byval AttrName)
Tagsstr = Tagsstr & " $"
Reg.Pattern = "\$" & AttrName & "=(.+?) \$"
Set Matches = Reg.Execute(Tagsstr)
For Each Match In Matches
GetAttr = Match.SubMatches(0)
Next
End Function
Function SetCache(Byval CacheName,Byval CacheValue)
CacheName = Filterstr(CacheName)
Application.Lock
Application("Template_" & CacheName) = CacheValue : Application("Template_" & CacheName & ".Time") = Now()
Application.UnLock
End Function
Function ChkCache(Byval CacheName)
Dim GetValue,GetTime
GetValue = GetCache(CacheName) : GetTime = GetCache(CacheName & ".Time")
If IsNull(GetValue) Or IsEmpty(GetValue) Then ChkCache = False : Exit Function
If Not IsDate(GetTime) Then ChkCache = False : Exit Function
If DateDiff("s",CDate(GetTime),Now()) >= Cachetime Then ChkCache = False Else ChkCache = True
End Function
Function GetCache(Byval CacheName)
CacheName = Filterstr(CacheName) : GetCache = Application("Template_" & CacheName)
End Function
Function Filterstr(Byval Str)
Filterstr = LCase(Str) : Filterstr = Replace(Filterstr," ","") : Filterstr = Replace(Filterstr,"'","") : Filterstr = Replace(Filterstr,"""","") : Filterstr = Replace(Filterstr,"=","") : Filterstr = Replace(Filterstr,"*","")
End Function
Public Function Loadfile()
Dim Obj
On Error Resume Next
Set Obj = Server.Createobject("adodb.stream")
With Obj
.Type = 2 : .Mode = 3 : .Open : .Charset = Code : .Position = Obj.Size : .Loadfromfile Server.Mappath(Template) : Content = .ReadText : .Close
End With
Set Obj = Nothing
If Err Then Response.Write "<font color=red>无法加载模板[" & Template & "]</font>" : Response.End
End Function
End Class
%>

给文章部分内容增加权限[类似论坛购买贴][11-09]

留言本仿论坛模板及部分功能[11-08]

雨哲自定义表单系统 For SiteWeaver[11-07]

在线支付模板管理[11-07]

全站搜索 For SiteWeaver 通用[11-07]

企业会员展示系统[11-07]

本文短地址：http://www.yz81.com/?ArticleID=3138 【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】

上一篇文章： asp验证码bmp图片的生成原理
下一篇文章： asp关键字函数运算附

[更多] 网友看法

数据载入中，请稍后……

发表评论

昵　称:		邮　箱:
评　分:	1分 2分 3分 4分 5分
内　容: （0/5000）插入链接
验证码:
雨哲提示：Alt+S快速发表

用户信息中心

与本文章相关内容

>> [雨缘博客]雨哲自定义表单系统 For Si　[日期：2008-11-07 03:03:03]
>> [产品中心]留言本论坛模板　[日期：2008-08-14 16:37:03]
>> [文章教程]ASP读取XML数据文件的方法　[日期：2008-08-14 00:52:26]
>> [文章教程]ASP中常见数学函数Abs Int 　[日期：2008-07-07 00:07:53]
>> [文章教程]asp关键字函数运算附　[日期：2008-07-04 16:23:37]
>> [雨缘博客]模板支持动态代码标签　[日期：2008-06-30 14:26:24]
>> [文章教程]asp验证码bmp图片的生成原理　[日期：2008-04-14 01:17:11]
>> [文章教程]Access内置函数　[日期：2008-04-10 01:14:49]
>> [文章教程]使用ASP加密算法加密你的数　[日期：2008-04-07 09:43:56]
>> [文章教程]使用ASP加密算法加密你的数　[日期：2008-04-07 09:41:43]

热门排行TOP10

推荐排行TOP10

[雨哲在线]最新公告

ASP模板引擎代码

雨[http://www.yz81.com]65031哲提示：代码片段