ASP 高级模板引擎实现类
来源:asp之家 发布时间:2011-03-25 10:54:00
代码如下:
Class template
Private c_Char, c_Path, c_FileName, c_Content, c_PageUrl, c_CurrentPage, c_PageStr, ReplacePageStr
Private TagName
' ***************************************
' 设置编码
' ***************************************
Public Property Let Char(ByVal Str)
c_Char = Str
End Property
Public Property Get Char
Char = c_Char
End Property
' ***************************************
' 设置模板文件夹路径
' ***************************************
Public Property Let Path(ByVal Str)
c_Path = Str
End Property
Public Property Get Path
Path = c_Path
End Property
' ***************************************
' 设置模板文件名
' ***************************************
Public Property Let FileName(ByVal Str)
c_FileName = Str
End Property
Public Property Get FileName
FileName = c_FileName
End Property
' ***************************************
' 获得模板文件具体路径
' ***************************************
Public Property Get FilePath
If Len(Path) > 0 Then Path = Replace(Path, "\", "/")
If Right(Path, 1) <> "/" Then Path = Path & "/"
FilePath = Path & FileName
End Property
' ***************************************
' 设置分页URL
' ***************************************
Public Property Let PageUrl(ByVal Str)
c_PageUrl = Str
End Property
Public Property Get PageUrl
PageUrl = c_PageUrl
End Property
' ***************************************
' 设置分页 当前页
' ***************************************
Public Property Let CurrentPage(ByVal Str)
c_CurrentPage = Str
End Property
Public Property Get CurrentPage
CurrentPage = c_CurrentPage
End Property
' ***************************************
' 输出内容
' ***************************************
Public Property Get Flush
Response.Write(c_Content)
End Property
' ***************************************
' 类初始化
' ***************************************
Private Sub Class_Initialize
TagName = "pjblog"
c_Char = "UTF-8"
ReplacePageStr = Array("", "")
End Sub
' ***************************************
' 过滤冲突字符
' ***************************************
Private Function doQuote(ByVal Str)
doQuote = Replace(Str, Chr(34), """)
End Function
' ***************************************
' 类终结
' ***************************************
Private Sub Class_Terminate
End Sub
' ***************************************
' 加载文件方法
' ***************************************
Private Function LoadFromFile(ByVal cPath)
Dim obj
Set obj = Server.CreateObject("ADODB.Stream")
With obj
.Type = 2
.Mode = 3
.Open
.Charset = Char
.Position = .Size
.LoadFromFile Server.MapPath(cPath)
LoadFromFile = .ReadText
.close
End With
Set obj = Nothing
End Function
' ***********************************************
' 获取正则匹配对象
' ***********************************************
Public Function GetMatch(ByVal Str, ByVal Rex)
Dim Reg, Mag
Set Reg = New RegExp
With Reg
.IgnoreCase = True
.Global = True
.Pattern = Rex
Set Mag = .Execute(Str)
If Mag.Count > 0 Then
Set GetMatch = Mag
Else
Set GetMatch = Server.CreateObject("Scripting.Dictionary")
End If
End With
Set Reg = nothing
End Function
' ***************************************
' 打开文档
' ***************************************
Public Sub open
c_Content = LoadFromFile(FilePath)
End Sub
' ***************************************
' 缓冲执行
' ***************************************
Public Sub Buffer
c_Content = GridView(c_Content)
Call ExecuteFunction
End Sub
' ***************************************
' GridView
' ***************************************
Private Function GridView(ByVal o_Content)
Dim Matches, SubMatches, SubText
Dim Attribute, Content
Set Matches = GetMatch(o_Content, "\<" & TagName & "\:(\d+?)(.+?)\>([\s\S]+?)<\/" & TagName & "\:\1\>")
If Matches.Count > 0 Then
For Each SubMatches In Matches
Attribute = SubMatches.SubMatches(1) ' kocms
Content = SubMatches.SubMatches(2) ' <Columns>...</Columns>
SubText = Process(Attribute, Content) ' 返回所有过程执行后的结果
o_Content = Replace(o_Content, SubMatches.value, "<" & SubText(2) & SubText(0) & ">" & SubText(1) & "</" & SubText(2) & ">", 1, -1, 1) ' 替换标签变量
Next
End If
Set Matches = Nothing
If Len(ReplacePageStr(0)) > 0 Then ' 判断是否标签变量有值,如果有就替换掉.
o_Content = Replace(o_Content, ReplacePageStr(0), ReplacePageStr(1), 1, -1, 1)
ReplacePageStr = Array("", "") ' 替换后清空该数组变量
End If
GridView = o_Content
End Function
' ***************************************
' 确定属性
' ***************************************
Private Function Process(ByVal Attribute, ByVal Content)
Dim Matches, SubMatches, Text
Dim MatchTag, MatchContent
Dim datasource, Name, Element, page, id
datasource = "" : Name = "" : Element = "" : page = 0 : id = ""
Set Matches = GetMatch(Attribute, "\s(.+?)\=\""(.+?)\""")
If Matches.Count > 0 Then
For Each SubMatches In Matches
MatchTag = SubMatches.SubMatches(0) ' 取得属性名
MatchContent = SubMatches.SubMatches(1) ' 取得属性值
If Lcase(MatchTag) = "name" Then Name = MatchContent ' 取得name属性值
If Lcase(MatchTag) = "datasource" Then datasource = MatchContent' 取得datasource属性值
If Lcase(MatchTag) = "element" Then Element = MatchContent ' 取得element属性值
If Lcase(MatchTag) = "page" Then page = MatchContent ' 取得page属性值
If Lcase(MatchTag) = "id" Then id = MatchContent ' 取得id属性值
Next
If Len(Name) > 0 And Len(MatchContent) > 0 Then
Text = Analysis(datasource, Name, Content, page, id) ' 执行解析属性
If Len(datasource) > 0 Then Attribute = Replace(Attribute, "datasource=""" & datasource & """", "")
If page > 0 Then Attribute = Replace(Attribute, "page=""" & page & """", "")
Attribute = Replace(Attribute, "name=""" & Name & """", "", 1, -1, 1)
Attribute = Replace(Attribute, "element=""" & Element & """", "", 1, -1, 1)
Process = Array(Attribute, Text, Element)
Else
Process = Array(Attribute, "", "div")
End If
Else
Process = Array(Attribute, "", "div")
End If
Set Matches = Nothing
End Function
' ***************************************
' 解析
' ***************************************
Private Function Analysis(ByVal id, ByVal Name, ByVal Content, ByVal page, ByVal PageID)
Dim Data
Select Case Lcase(Name) ' 选择数据源
Case "loop" Data = DataBind(id, Content, page, PageID)
Case "for" Data = DataFor(id, Content, page, PageID)
End Select
Analysis = Data
End Function
' ***************************************
' 绑定数据源
' ***************************************
Private Function DataBind(ByVal id, ByVal Content, ByVal page, ByVal PageID)
Dim Text, Matches, SubMatches, SubText
Execute "Text = " & id & "(1)" ' 加载数据源
Set Matches = GetMatch(Content, "\<Columns\>([\s\S]+)\<\/Columns\>")
If Matches.Count > 0 Then
For Each SubMatches In Matches
SubText = ItemTemplate(SubMatches.SubMatches(0), Text, page, PageID)' 执行模块替换
Content = Replace(Content, SubMatches.value, SubText, 1, -1, 1)
Next
DataBind = Content
Else
DataBind = ""
End If
Set Matches = Nothing
End Function
' ***************************************
' 匹配模板实例
' ***************************************
Private Function ItemTemplate(ByVal TextTag, ByVal Text, ByVal page, ByVal PageID)
Dim Matches, SubMatches, SubMatchText
Dim SecMatch, SecSubMatch
Dim i, TempText
Dim TextLen, TextLeft, TextRight
Set Matches = GetMatch(TextTag, "\<ItemTemplate\>([\s\S]+)\<\/ItemTemplate\>")
If Matches.Count > 0 Then
For Each SubMatches In Matches
SubMatchText = SubMatches.SubMatches(0)
' ---------------------------------------------
' 循环嵌套开始
' ---------------------------------------------
SubMatchText = GridView(SubMatchText)
' ---------------------------------------------
' 循环嵌套结束
' ---------------------------------------------
If UBound(Text, 1) = 0 Then
TempText = ""
Else
TempText = ""
' -----------------------------------------------
' 开始分页
' -----------------------------------------------
If Len(page) > 0 And page > 0 Then
If Len(CurrentPage) = 0 Or CurrentPage = 0 Then CurrentPage = 1
TextLen = UBound(Text, 2)
TextLeft = (CurrentPage - 1) * page
TextRight = CurrentPage * page - 1
If TextLeft < 0 Then TextLeft = 0
If TextRight > TextLen Then TextRight = TextLen
c_PageStr = MultiPage(TextLen + 1, page, CurrentPage, PageUrl, "float:right", "", False)
If Int(Len(c_PageStr)) > 0 Then
ReplacePageStr = Array("<page:" & Trim(PageID) & "/>", c_PageStr)
Else
ReplacePageStr = Array("<page:" & Trim(PageID) & "/>", "")
End If
Else
TextLeft = 0
TextRight = UBound(Text, 2)
End If
For i = TextLeft To TextRight
TempText = TempText & ItemReSec(i, SubMatchText, Text) ' 加载模板内容
Next
End If
Next
ItemTemplate = TempText
Else
ItemTemplate = ""
End If
Set Matches = Nothing
End Function
' ***************************************
' 替换模板字符串
' ***************************************
Private Function ItemReSec(ByVal i, ByVal Text, ByVal Arrays)
Dim Matches, SubMatches
Set Matches = GetMatch(Text, "\$(\d+?)")
If Matches.Count > 0 Then
For Each SubMatches In Matches
Text = Replace(Text, SubMatches.value, doQuote(Arrays(SubMatches.SubMatches(0), i)), 1, -1, 1) '执行替换
Next
ItemReSec = Text
Else
ItemReSec = ""
End If
Set Matches = Nothing
End Function
' ***************************************
' 全局变量函数
' ***************************************
Private Sub ExecuteFunction
Dim Matches, SubMatches, Text, ExeText
Set Matches = GetMatch(c_Content, "\<function\:([0-9a-zA-Z_\.]*?)\((.*?)\""(.+?)\""(.*?)\)\/\>")
If Matches.Count > 0 Then
For Each SubMatches In Matches
Text = SubMatches.SubMatches(0) & "(" & SubMatches.SubMatches(1) & """" & SubMatches.SubMatches(2) & """" & SubMatches.SubMatches(3) & ")"
Execute "ExeText=" & Text
c_Content = Replace(c_Content, SubMatches.value, ExeText, 1, -1, 1)
Next
End If
Set Matches = Nothing
End Sub
' ***************************************
' 普通替换全局标签
' ***************************************
Public Property Let Sets(ByVal t, ByVal s)
Dim SetMatch, Bstr, SetSubMatch
Set SetMatch = GetMatch(c_Content, "(\<Set\:([0-9a-zA-Z_\.]*?)\(((.*?)" & t & "(.*?))?\)\/\>)")
If SetMatch.Count > 0 Then
For Each SetSubMatch In SetMatch
Execute "Bstr = " & SetSubMatch.SubMatches(1) & "(" & SetSubMatch.SubMatches(3) & """" & s & """" & SetSubMatch.SubMatches(4) & ")"
c_Content = Replace(c_Content, SetSubMatch.Value, Bstr, 1, -1, 1)
Next
End If
Set SetMatch = Nothing
Set SetMatch = GetMatch(c_Content, "(\<Set\:" & t & "\/\>)")
If SetMatch.Count > 0 Then
For Each SetSubMatch In SetMatch
c_Content = Replace(c_Content, SetSubMatch.Value, s, 1, -1, 1)
Next
End If
Set SetMatch = Nothing
End Property
End Class
猜你喜欢
- 很常见的一个图片轮播Flash,使用之后发现在IE下按F5刷新之后Flash区域就变成一大块背景色,内容轮播出不来了。有趣的是右键点击Fla
- 本人最近在当当网上购买了一本关于用户体验的书,在此把最实在的内容整理下发给大家分享下。第一步:表现层视觉设计,也就是我们说的网页设计师做的工
- 如果你已经理解了block formatting contexts那么请继续,否则请先看看这篇文章。Overflow能够做一些很牛掰的事情,
- 美化主要表现在鼠标放到菜单上后(即鼠标悬停)的效果,这里首先介绍几个经常用到的CSS属性:backgr
- 为了防止某些别有用心的人从外部访问数据库,盗取数据库中的用户姓名、密码、信用卡号等其他重要信息,在我们创建数据库驱动的解决方案时,我们首先需
- Float(浮动)概念也许是CSS中最让人迷惑的一个概念吧。Float经常被错误理解,而且因为将上下文元素全部浮动导致的可读性、
- 有的时候取出全部数据库记录也许正好满足你的要求,不过,在大多数情况下我们通常只需得到部分记录。这样一来该如何设计查询呢?当然会更费点脑筋了,
- Sql Server的存储过程是一个被命名的存储在服务器上的Transacation-Sql语句集合,是封装重复性工作的一种方法,它支持用户
- SQL Server数据库日志清除的两个方法:方法一一般情况下,SQL数据库的收缩并不能很大程度上减小数据库大小,其主要作用是收缩日志大小,
- 字体的处理在网页设计中无论怎么强调也不为过, 毕竟网页使用来传递信息的, 而最经典最直接的信息传递方式就是文字,&nbs
- 在document.form1.submit();后加document.body.innerHtml = "W
- 在用户登录windows操作系统的时候,如果触发到了登录表单的密码录入框上,并且此时按下了“大写锁定键(Caps Lock)”,那么界面上会
- 一段重用很高的ajax代码,可以套用 <!DOCTYPE HTML
- 网页开发人员常常希望能够了解并掌握多种语言,结果是,学习一门语言的所有内容是棘手的,但是却很容易发现你并没有完全利用那些比较特殊却很有用的标
- 跨浏览器的本地存储(一):userData behaviorDOM Storage,是基于 Web Applications 1.0 spe
- 要防止同一用户同时登陆,首页应该记录在线用户的信息(这里与用户名为例),然后判断正在登陆的用户里面是否已存在。在这里使用一个cache存放已
- 本章的前面讨论如何使用SQL向一个表中插入数据。但是,如果你需要向一个表中添加许多条记录,使用SQL语句输入数据是很不方便的。幸运的是,My
- 以前在一个图书类网站看到这样一个功能:客户可以按条件搜索书目的信息,服务器会将符合条件的信息筛选出来保存为一个Excel文件供客户下载。今天
- 我们将在下面的例子中使用这个 XML 文档。<?xml version="1.0" encod
- 如果有空格就用%20代替,如果有其它字符就用%ASCII代替,如果有汉字等四个字节的字符,就用两个%ASCII来代替。不过有时候我们也需要将