QQ咨询 官方微信

添加微信好友

官方小程序

百度小程序

微信小程序

头条小程序

关于我们

asp基础

ASP模板引擎实现(ASP网页静态化)

 admin  2013-11-19 08:53:00

 模板引擎说明:
1.此模板引擎由个人独立完成,转载或使用请联系
2.引擎内部使用了其它函数及操作类,暂时不能直接使用
3.发出来是想分享一下自己的解析思路,希望有兴趣的朋友点评一下
以下是说明
==============================分隔线====================================
模板对象属性
bHtm //是否生成静态
filePath //指定静态文件路径,包括文件名,生成静态时必须指定
相对于htmPath的路径
iche //缓存时间,以秒计,不指定时从常量内取值,0时不缓存
sChr //模板文件的编码,默认gb2312
全局变量
//开始替换一次,最后替换一次
{$变量名}
{$apppath} /程序根目录
{$filepath} /上传文件目录
{$template} /当前模板目录
{$source} /当前模板资源目录
{$SiteName}
{$SiteTitle}
{$SiteDesc}
{$SiteKeyWords}
{$siteurl}
{$lang} //当前语言
在标签内使用 $变量名
//系统变量
{$query.}
{$form.}
{$cookie.}
{$server.}
{$session.}
以上变量不区分大小写
{$obj.key} /注册的obj变量的key值.
变量格式
{var:} //直接注册的变量
{$obj.key} //注册的obj的属性
{@} //循环内变量
支持变量格式化,以|分割每一个参数,不需使用引号,函数名不区分大小写
fmtdate 格式化日期 kindly/YYYY-MM-DD HH:NN:SS WWW,不是日期格式将原样输出
cutstr 截取化字符串 长度|尾符
lcase
ucase
nohtml 去除html标签
html 输出html格式
ubb 将ubb转为html
escape 编码
jscode js编码
replace 要替换的字符|替换的字符
trip 去除多余空格
fmtnum 格式化数字 类型|长度|是否截短 1.填充整型,前补0,2.填充小数,后补0,3.转化16进制格式,4.十六进制转换十进制
url 1.内容页url,2.列表页url | 类别|id/page
default 默认值.字符串为空时
iif 真|假 /会先强制转换布尔
filesize将数值转换为磁盘空间计量

以下标签名小写
自定义变量(通过assign注册的字符串或数字)
{var:}
//开始读取包含
包含文件,相对于当前模板文件夹,可包含子目录
{include(fiename)}
以下标签带有属性,属性必须使用"或'包括,属性内的'使用%27,"使用%22代替
属性名最好使用小写
有[]或[的地方表示该属性可有可无,没有则表示该属性必须指定值
函数 用于对标签内容使用指定函数解析
{fn: func="" [args="" [argtype=""]]}{/fn}
函数必须为自定义函数,必须返回字符串,不能使用系统函数
函数参数个数必须符合要求,最多5个参数
第一个参数为标签内容
如果需要其它的参数,使用args=""属性.
参数用,隔开,参数内的,使用%2C表示,%使用%25表示
argtype指定对应位置的参数格式,可使用s-字符串,i-整型,f-浮点型,b-布尔型, ,分隔
不指定时默认全部以字符串传递
判断 //可嵌套
{if:}{elseif:}{else}{/if}
循环 //可嵌套
{for:}{/for}
{@var}
var=
[from= //省略时为1
to=
[step= //省略时为1
{foreach:}{/foreach}
{@var.name}
{@var.value}
var=
name= //注册的obj
{loop:}{loopelse}{/loop}
{@name.}
name= /已注册的,recordset
[count= /与limit同用时优先级较高
[limit= /a,b表示从recordset的第a行开始显示b条,只有一个值则等同于count
{sql:}{sqlelse}{/sql}
{@name.}
{@name.@index} /当前索引
name=
table=
[count= /显示数量,最多100行
[where= /不含where,完整的条件语句,字段名以$p$开头
[field= /以,分割字段名
[limit= /a,b 起始,长度,必须是数值,如果只有一个值,则表示查询前N条
[order= /以,分割排序值

局部不缓存
<nocache>
</nocache>
该标不可嵌套,不可用在其它标签内部
局部长缓存,不受全局缓存时间影响,但当全局缓存未过期时不会更新
该功能针对需要复杂解析或多次读取数据但一般不会更新的部分进行缓存
<cache name="" [time=""]>
</cache>
name属性必须,且所有局部缓存不能同名
time以小时计,省略时永久缓存,除非清除缓存
==============================沧桑的分隔线====================================
以下是解析类的源码
Vbscript代码
'**********************************
'ASP模板引擎
'用法: Set var=new sTemplate
' [var.prop=vars]
' [var.assign name,value]
' var.display tplpath
'作者: shirne
'日期: 2011/9/10
'**********************************
Class sTemplate
Private oData, oType, oReg, oSql, oStm, oFso
Private sApp, sTpl, sExt, sHtm, sFmt
Private iStart,iQuery '开始运行时间

Private htmPath,aCache,chePath
Public bHtm,filePath,iChe,sChr

Private Sub Class_Initialize
iStart = Timer()
sApp = AppPath
sTpl = AppPath & TEMPLATE_PATH & "default/"
sExt = ".html"
sChr = "gb2312" '编码
sFmt = "wd/-[].u4000-u9000" '变量格式化允许的字符,不能有}
iChe = CACHE_TIME '缓存时间以秒计

bHtm = HTML_OPEN '是否生成静态,生成静态时必须指定filepath
iQuery = 0 '自定义的sql查询次数

htmPath = AppPath&"html/"&lang&"/" '静态文件路径
chePath = AppPath&"cache/"&lang&"/" '缓存文件路径

Set oData = Server.CreateObject("Scripting.Dictionary") '存放注册数据
Set oType = Server.CreateObject("Scripting.Dictionary") '存放数据类型
Set oStm = Server.CreateObject("ADODB.Stream")
Set oFso = Server.CreateObject("Scripting.FileSystemObject")
Set oReg = REObject("",True,True,True)

CheckPath htmPath
CheckPath chePath
End Sub
Private Sub Class_Terminate
oData.RemoveAll
oType.RemoveAll
sHtm = ""
Set oData = Nothing
Set oType = Nothing
Set oStm = Nothing
Set oFso = Nothing
Set oReg = Nothing
End Sub

'注册变量或obj或数组,重复注册会替换掉旧的
Public Sub assign(sName,obj)
If oData.Exists(sName) Then
oData(sName)=obj
oType(sName)=vType(obj)
Else
oData.Add sName,obj
oType.Add sName,vType(obj)
End If
End Sub

'显示
Public Sub Display(fTpl)
Dim n,i,j,k,fPathfPath,iTmp
j = -1
fPath = chePath&URLEncode(GetFileStr)&".cache"
If iChe>0 Then '获取缓存
If oFso.FileExists(Server.MapPath(fPath)) Then
Set f=oFso.GetFile(Server.MapPath(fPath))
If DateDiff("s",f.DateLastModified,Now)<iChe Then
sHtm=ReadFile(fPath)
End If
End If
End If
If sHtm="" Then
sHtm = ReadFile(sTpl&fTpl)
sHtm = include(sHtm)

If InStr(sHtm,"<nocache>")>0 Then
i=InStr(sHtm,"<nocache>")
j=0
ReDim aCache(0)
Do Until i<1
ReDim Preserve aCache(j)
k=InStr(i,sHtm,"</nocache>")
If k<1 Then cErr(15)
aCache(j)=Mid(sHtm,i+9,k-i-10)
i=InStr(k,"<nocache>")
If i>0 Then j=j+1
Loop
End If

sHtm = getCache(sHtm)

sHtm = iReplace(sHtm)
sHtm = analyTpl(sHtm)
'sHtm = iReplace(sHtm)
If iChe>0 Then
iTmp=sHtm
If j>-1 Then
i=1
For k=0 To j
i=InStr(i,iTmp,"<nocache>")
n=InStr(i,iTmp,"</nocache>")
If i<0 Or n<0 Then Exit For
iTmp=Replace(iTmp,Mid(iTmp,i+9,n-i-10),aCache(k))
i=n
Next
sHtm = Replace(sHtm,"<nocache>","")
sHtm = Replace(sHtm,"</nocache>","")
End If
SaveFile fPath,iTmp
End If
Else
If InStr(sHtm,"<nocache>")>0 Then
sHtm = iReplace(sHtm)
sHtm = analyTpl(sHtm)
'sHtm = iReplace(sHtm)
sHtm = Replace(sHtm,"<nocache>","")
sHtm = Replace(sHtm,"</nocache>","")
End If
End If
If CBol(bHtm) Then
CheckPath(getDir(htmPath&filePath))
SaveFile htmPath&filePath,sHtm
End If

j=CCur(Timer()-iStart)
If j<1 Then j="0"&j
sHtm=Replace(sHtm,"{#ExecuteTime}","Processed in "&j&" second(s), "&iQuery&" queries:")
Echo sHtm
End Sub

Public Sub ClearCache
On Error Resume Next
If oFso.FolderExists(Server.MapPath(chePath)) Then
oFso.DeleteFolder Server.MapPath(chePath)
End If
If Err Then cErr 32
End Sub

Private Function getCache(sCont)
Dim i,ii,iii
i=InStr(sCont,"<cache")
If i<1 Then
getCache=sCont
Else
Dim j,sLabel,sTmp,oAtt,cPath,sTemp
Do
ii=InStr(i,sCont,"</cache>")
If ii<1 Then cErr 16
j=InStr(i,sCont,">")
sLabel=Mid(sCont,i+6,j-i-6)
sTemp=Mid(sCont,j+1,ii-j-1)
Set oAtt=analyLabel(sLabel)
If oAtt.Exists("name") Then
CheckPath chePath&"global/"
cPath=chePath&"global/"&oAtt("name")&".cache"
If oFso.FileExists(Server.MapPath(cPath)) Then
If oAtt.Exists("time") Then
If DateDiff("h",(oFso.getFile(Server.MapPath(cPath))).DateLastModified,Now)<oAtt("time") Then
sTmp=ReadFile(cPath)
End If
Else
sTmp=ReadFile(cPath)
End If
End If
If sTmp="" Then
sTmp=sTemp

sTmp = iReplace(sTmp)
sTmp = analyTpl(sTmp)
SaveFile cPath,sTmp
End If
sCont=Replace(sCont,"<cache"&sLabel&">"&sTemp&"</cache>",sTmp)
i=InStr(i+Len(sTmp),sCont,"<cache")
sTmp=""
Else
i=InStr(ii,sCont,"<cache")
End If
Loop Until i<1

getCache=sCont
End If
End Function

Private Function GetFileStr()
Dim strTemps
strTemps = strTemps & Request.ServerVariables("URL")
If Trim(Request.QueryString) <> "" Then
strTemps = strTemps & "?" & Trim(Request.QueryString)
Else
strTemps = strTemps
End If
GetFileStr = strTemps
End Function

Private Function include(sContent)
Dim Matches, Match, i
include=sContent
i=0
oReg.Pattern="{includes*((['""])?([w.d/]+)1)}"
Do
Set Matches=oReg.Execute(sContent)
For Each Match In Matches
include=Replace(include,Match.Value,ReadFile(sTpl&Match.SubMatches(1)))
Next
i=i+1
Loop While Matches.Count>0 And i<5 '最深5层包含
If Matches.Count>0 Then
include=oReg.Replace(include,"")
End If
End Function

Private Sub SaveFile(ByVal tpl,html)
tpl = Server.MapPath(tpl)
oStm.Type = 2
oStm.Mode = 3
oStm.CharSet= sChr
oStm.Open
oStm.WriteText html
oStm.SetEOS
oStm.SaveToFile tpl,2
oStm.Close
End Sub

Private Function ReadFile(ByVal tpl)
tpl = Server.MapPath(tpl)
oStm.Type = 2
oStm.Mode = 3
oStm.CharSet= sChr
oStm.Open
If oFso.FileExists(tpl) Then
oStm.LoadFromFile tpl
ReadFile=oStm.ReadText
oStm.Flush
oStm.Close
Else
cErr 1
End If
End Function

Private Function iReplace(sHtm)
Dim n, oMth, Match, iTmp

oReg.Pattern="{$apppath}":sHtm=oReg.Replace(sHtm,AppPath)
oReg.Pattern="{$filepath}":sHtm=oReg.Replace(sHtm,AppPath & FILE_UP_PATH)
oReg.Pattern="{$template}":sHtm=oReg.Replace(sHtm,sTpl)
oReg.Pattern="{$source}":sHtm=oReg.Replace(sHtm,sTpl&"resource/")
oReg.Pattern="{$SiteName}":sHtm=oReg.Replace(sHtm,Eval("SiteName"&lang))
oReg.Pattern="{$SiteTitle}":sHtm=oReg.Replace(sHtm,Eval("SiteTitle"&lang))
oReg.Pattern="{$SiteDesc}":sHtm=oReg.Replace(sHtm,Eval("SiteDesc"&lang))
oReg.Pattern="{$SiteKeyWords}":sHtm=oReg.Replace(sHtm,Eval("SiteWords"&lang))
oReg.Pattern="{$CopyRight}":sHtm=oReg.Replace(sHtm,Eval("CopyRight"&lang))
oReg.Pattern="{$SiteURL}":sHtm=oReg.Replace(sHtm,SiteURL)
oReg.Pattern="{$lang}":sHtm=oReg.Replace(sHtm,lang)

oReg.Pattern="({[^{]+)$apppath([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&AppPath&"$2")
oReg.Pattern="({[^{]+)$filepath([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&AppPath & FILE_UP_PATH&"$2")
oReg.Pattern="({[^{]+)$template([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&sTpl&"$2")
oReg.Pattern="({[^{]+)$source([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&sTpl&"resource/"&"$2")
oReg.Pattern="({[^{]+)$SiteName([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&Eval("SiteName"&lang)&"$2")
oReg.Pattern="({[^{]+)$SiteTitle([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&Eval("SiteTitle"&lang)&"$2")
oReg.Pattern="({[^{]+)$SiteDesc([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&Eval("SiteDesc"&lang)&"$2")
oReg.Pattern="({[^{]+)$SiteKeyWords([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&Eval("SiteWords"&lang)&"$2")
oReg.Pattern="({[^{]+)$CopyRight([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&Eval("CopyRight"&lang)&"$2")
oReg.Pattern="({[^{]+)$SiteURL([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&SiteURL&"$2")
oReg.Pattern="({[^{]+)$lang([^}]*})":sHtm=oReg.Replace(sHtm,"$1"&lang&"$2")
For Each n In oData
If oType(n)=0 Then
oReg.Pattern="{var:"&n&"((?:|["& sFmt &"]+)*)?}"
Set oMth=oReg.Execute(sHtm)
For Each Match In oMth
If Match.SubMatches.Count>0 Then
sHtm=Replace(sHtm,Match.Value,fmtVar(oData(n),Match.SubMatches(0)))
Else
sHtm=Replace(sHtm,Match.Value,oData(n))
End If
Next
'替换标签内变量
oReg.Pattern="{[^{]+@var:"&n&"[^}]*}"
Set oMth=oReg.Execute(sHtm)
For Each Match In oMth
sHtm=Replace(sHtm,Match.Value,Replace(Match.Value,"@var:"&n,oData(n)))
Next
End If
Next
oReg.Pattern="{$([dw]+).([dw]+)((?:|["& sFmt &"]+)*)?}"
Set oMth=oReg.Execute(sHtm)
For Each Match In oMth
If Match.SubMatches.Count<=2 Then iTmp="" Else iTmp=Match.SubMatches(2)
sHtm=Replace(sHtm,Match.Value,getValue(Match.SubMatches(0),Match.SubMatches(1),iTmp))
Next
'替换标签内变量
oReg.Pattern="{[^{]+$([dw]+).([dw]+)[^}]*}"
Set oMth=oReg.Execute(sHtm)
For Each Match In oMth
If Match.SubMatches.Count<=2 Then iTmp="" Else iTmp=Match.SubMatches(2)
sHtm=Replace(sHtm,Match.Value,_
Replace(Match.Value,"$"&Match.SubMatches(0)&"."&Match.SubMatches(1),_
getValue(Match.SubMatches(0),Match.SubMatches(1),iTmp)))
Next
iReplace=sHtm
End Function

'解析模板
Private Function analyTpl(ByVal sCont)
Dim i,sTag,sLabel,iEnd,iDiv,sTemp,ilayer
Dim iPos,iRtn,iTmp,j,k,l,ii,iii,oAtt,sTmp,sLbl
i=InStr(sCont,"{")

Do While i>0
'标签的内容
sLabel=Mid(sCont,i+1,InStr(i,sCont,"}")-i-1)
If InStr(sLabel,":")>0 Then '跳过其它标签
'标签名
sTag=Left(sLabel,InStr(sLabel,":")-1)
'标签结束位置
iEnd=InStr(i,sCont,"{/"&sTag&"}")
If iEnd <1 Then cErr sTag
'标签模板
sTemp=Mid(sCont,i+Len(sLabel)+2,iEnd-i-Len(sLabel)-2)
'是否存在嵌套
iDiv=InStr(sTemp,"{"&sTag&":")
ilayer=0
Do While iDiv>0
ilayer=ilayer+1 '层数加1
iEnd=InStr(iEnd+1,sCont,"{/"&sTag&"}")
If iEnd<1 Then cErr sTag
sTemp=Mid(sCont,i+Len(sLabel)+2,iEnd-i-Len(sLabel)-2)
iDiv=InStr(iDiv+1,sTemp,"{"&sTag&":")
Loop

'将变量缓存,以防后期被改变
sTmp=sTemp
sLbl=sLabel

iRtn="" '解析返回值
Select Case sTag
Case "if"
If ilayer=0 Then '无嵌套时执行解析
If InStr(sTemp,"{elseif:")>0 Then
iTmp=Split(sTemp,"{elseif:")
k=UBound(iTmp)
If judge(Mid(sLabel,4)) Then
iRtn=iTmp(0)
Else
For j=1 To k
If judge(Left(iTmp(j),InStr(iTmp(j),"}")-1)) Then
iRtn=Mid(iTmp(j),InStr(iTmp(j),"}")+1)
End If
Next
End If
If iRtn="" And InStr(iTmp(k),"{else}")>0 Then
iRtn=analyTpl(Split(iTmp(k),"{else}")(1))
Else
iRtn=analyTpl(iRtn)
End If
ElseIf InStr(sTemp,"{else}")>0 Then
iTmp=Split(sTemp,"{else}")
If judge(Mid(sLabel,4)) Then
iRtn=analyTpl(iTmp(0))
Else
iRtn=analyTpl(iTmp(1))
End If
Else
If judge(Mid(sLabel,4)) Then
iRtn=analyTpl(sTemp)
End If
End If
Else '有嵌套时循环解析
sTemp=Replace(sTemp,"{else}","{elseif:1=1}")
ii=InStr(sTemp,"{elseif:")
k=InStr(sTemp,"{if:")
If judge(Mid(sLabel,4)) Then
If ii<0 Then
iRtn=analyTpl(sTemp)
ElseIf k>ii Then '隐含条件 ii>0
iRtn=analyTpl(Mid(sTemp,ii-1))
Else '隐含条件ii>0,k<ii
iDiv=InStr(sTemp,"{/if}")
Do Until InStr(k+1,Left(sTemp,iDiv),"{if:")<1
k=InStr(k+1,sTemp,"{if:")
iDiv=InStr(iDiv+1,sTemp,"{/if}")
If iDiv<1 Then cErr(12)
Loop
iDiv=InStr(iDiv,sTemp,"{elseif:")
If iDiv>0 Then
iRtn=analyTpl(Left(sTemp,iDiv-1))
Else
iRtn=analyTpl(sTemp)
End If
End If
ElseIf ii>0 Then '不存在else或elseif,则整段已经被抛弃
If k<ii Then '隐含条件k>0
iDiv=InStr(sTemp,"{/if}")
Do Until InStr(k+1,Left(sTemp,iDiv),"{if:")<1
k=InStr(k+1,sTemp,"{if:")
iDiv=InStr(iDiv+1,sTemp,"{/if}")
If iDiv<1 Then cErr(12)
Loop
ii=InStr(iDiv,sTemp,"{elseif:")
End If
If ii>0 Then '与上面ii>0不同,如果首段if排除后已经没有else,也抛弃
sLabel=Mid(sTemp,ii+8,InStr(ii,sTemp,"}")-ii-8)

Do Until judge(sLabel) '当前elseif内标签不为真
k=InStr(ii,sTemp,"{if:")
iDiv=InStr(ii,sTemp,"{/if}")
ii=InStr(ii+1,sTemp,"{elseif:")
If k>0 And k<ii Then '下一个else前有if
Do Until InStr(k+1,Left(sTemp,iDiv),"{if:")<1
k=InStr(k+1,sTemp,"{if:")
iDiv=InStr(iDiv+1,sTemp,"{/if}")
If iDiv<1 Then cErr(12)
Loop
ii=InStr(iDiv,sTemp,"{elseif:")
End If
If ii<1 Then Exit Do
sLabel=Mid(sTemp,ii+8,InStr(ii,sTemp,"}")-ii-8)
Loop

'寻找当前内容段作为返回
If ii>0 Then
iii=InStr(ii,sTemp,"}") '定位当前标签结束位置
k=InStr(ii,sTemp,"{if:")
iDiv=InStr(ii,sTemp,"{/if}")
ii=InStr(ii,sTemp,"{elseif:")
If k>0 And k<ii Then '下一个else前有if
Do Until InStr(k+1,Left(sTemp,iDiv),"{if:")<1
k=InStr(k+1,sTemp,"{if:")
iDiv=InStr(iDiv+1,sTemp,"{/if}")
If iDiv<1 Then cErr(12)
Loop
ii=InStr(iDiv,sTemp,"{elseif:")
End If
If ii<1 Then
iRtn=analyTpl(Mid(sTemp,iii+1))
Else
iRtn=analyTpl(Mid(sTemp,iii+1,ii-2))
End If
End If
End If
End If
End If
Case "fn"
Set oAtt=analyLabel(sLabel)
If oAtt.Exists("func") Then
Set k=GetRef(oAtt("func"))
If oAtt.Exists("args") Then
ii=Split(oAtt("args"),",")
If oAtt.Exists("argtype") Then
iii=Split(oAtt("argtype")&",,,,,",",")
Else
iii=Split(",,,,,",",")
End If
For j=0 To UBound(ii)
Select Case LCase(iii(5))
Case "i"
ii(j)=parseInt(ii(j))
Case "f"
If IsNumeric(ii(j)) Then ii(j)=CDbl(ii(j)) Else ii(j)=0
Case "b"
ii(j)=CBol(ii(j))
Case Else
ii(j)=decode(ii(j),True)
End Select
If j>4 Then Exit For
Next
Select Case UBound(ii)
Case 0
iRtn=k(sTemp,ii(0))
Case 1
iRtn=k(sTemp,ii(0),ii(1))
Case 2
iRtn=k(sTemp,ii(0),ii(1),ii(2))
Case 3
iRtn=k(sTemp,ii(0),ii(1),ii(2),ii(3))
Case 4
iRtn=k(sTemp,ii(0),ii(1),ii(2),ii(3),,ii(4))
End Select
Else
iRtn=k(sTemp)
End If
iRtn=analyTpl(iRtn)
End If
Case "for"
Set oAtt=analyLabel(sLabel)
If oAtt.Exists("var") And oAtt.Exists("to") Then
oAtt("to")=parseInt(oAtt("to"))
If oAtt.Exists("from") Then oAtt("from")=parseInt(oAtt("from")) Else oAtt.Add "from",1
If oAtt.Exists("step") Then k=ParseInt(oAtt("step")) Else k=1
For j=ParseInt(oAtt("from")) To ParseInt(oAtt("to")) Step k
k = Replace(sTemp,"{@"&oAtt("var")&"}",j)
oReg.Pattern="({[^{]+)@"&oAtt("var")&"([^.}]*})"
iRtn = iRtn & oReg.Replace(k,"$1"&j&"$2")
Next
iRtn=analyTpl(iRtn)
End If
Case "foreach"
Set oAtt=analyLabel(sLabel)
If oAtt.Exists("var") And oAtt.Exists("name") Then
If oData.Exists(oAtt("name")) Then
If oType(oAtt("name"))=2 Or oType(oAtt("name"))=4 Then
For Each j In oData(oAtt("name"))
k=Replace(sTemp,"{@"&oAtt("var")&".name}",j)
k=Replace(k,"{@"&oAtt("var")&".value}",j)

oReg.Pattern="({[^{]+)@"&oAtt("var")&".name([^}]*})"
k = oReg.Replace(k,"1"&j&"2")
oReg.Pattern="({[^{]+)@"&oAtt("var")&".value([^}]*})"
iRtn = iRtn & oReg.Replace(k,"$1"&oData(oAtt("name"))(j)&"$2")
Next
iRtn=analyTpl(iRtn)
End If
End If
End If
Case "loop"
Set oAtt=analyLabel(sLabel)
If oAtt.Exists("name") Then
If oData.Exists(oAtt("name")) Then

For ii=1 To Len(sTemp)
l=InStr(ii,sTemp,"{loopelse}")
If l>0 Then
iDiv=InStr(ii,sTemp,"{loop:")
If iDiv>l Or iDiv<1 Then
sTemp=Left(sTemp,l-1)&Replace(sTemp,"{loopelse}","{loopelseMARK}",l,1)
Exit For
Else
ii=InStr(ii,sTemp,"{/loop}")
Do Until iDiv<1
If ii<1 Then cErr(13)
iDiv=InStr(iDiv+1,sTemp,"{loop:")
If iDiv>0 Then ii=InStr(ii+1,sTemp,"{/loop}")
Loop
End If
End If
Next

If oType(oAtt("name"))=3 Then
If oAtt.Exists("limit") Then
If InStr(oAtt("limit"),",")<1 Then oAtt("limit")="1,"&oAtt("limit")
oAtt("limit")=Split(oAtt("limit"),",")
oAtt("limit")(0)=parseInt(oAtt("limit")(0))
k=parseInt(oAtt("limit")(1))
Else
k=oData(oAtt("name")).RecordCount
End If
If oAtt.Exists("count") Then k=ParseInt(oAtt("count"))
If k>100 Then k=100 '最多输出100条
iii=Split(sTemp&"{loopelseMARK}","{loopelseMARK}")
If oData(oAtt("name")).EOF Then
iRtn=iii(1)
Else
ii=oData(oAtt("name")).AbsolutePosition '记录rscordset起始位置
If oAtt.Exists("limit") Then
If oData(oAtt("name")).RecordCount>oAtt("limit")(0) Then
oData(oAtt("name")).AbsolutePosition=oAtt("limit")(0)
Else
oData(oAtt("name")).AbsolutePosition=oData(oAtt("name")).RecordCount
End If
End If
For j=1 To k
iRtn=iRtn & Replace(Replace(subReplace(iii(0),oData(oAtt("name")),oAtt("name")),"{@"&oAtt("name")&".@index}",j),"@"&oAtt("name")&".@index",j)
oData(oAtt("name")).MoveNext
If oData(oAtt("name")).EOF Then oData(oAtt("name")).AbsolutePosition=ii:Exit For
Next
End If
iRtn=analyTpl(iRtn)
End If
End If
End If
Case "sql"
Set oAtt=analyLabel(sLabel)
If oAtt.Exists("name") And oAtt.Exists("table") Then
If LCase(oAtt("table"))<>"admin" Then

For ii=1 To Len(sTemp)
l=InStr(ii,sTemp,"{sqlelse}")
If l>0 Then
iDiv=InStr(ii,sTemp,"{sql:")
If iDiv>l Or iDiv<1 Then
sTemp=Left(sTemp,l-1)&Replace(sTemp,"{sqlelse}","{sqlelseMARK}",l,1)
Exit For
Else
ii=InStr(ii,sTemp,"{/sql}")
Do Until iDiv<1
If ii<1 Then cErr(14)
iDiv=InStr(iDiv+1,sTemp,"{sql:")
If iDiv>0 Then ii=InStr(ii+1,sTemp,"{/sql}")
Loop
End If
End If
Next

Set k=New MakeSQL
k.Table(oAtt("table"))
If oAtt.Exists("field") Then k.field(Split(oAtt("field"),","))
If oAtt.Exists("where") Then k.where(Array(decode(oAtt("where"),True)))
If oAtt.Exists("limit") Then
If InStr(oAtt("limit"),",")<1 Then oAtt("limit")="1,"&oAtt("limit")
oAtt("limit")=Split(oAtt("limit"),",")
k.limit oAtt("limit")(0),oAtt("limit")(1)
End If
If oAtt.Exists("order") Then k.order(Split(oAtt("order"),","))
Set l=k.CreateSQL("select",True)
iQuery=iQuery+1
iii=Split(sTemp&"{sqlelseMARK}","{sqlelseMARK}")
If l.EOF Then
iRtn=iii(1)
Else
If oAtt.Exists("count") Then ii=ParseInt(oAtt("count")) Else ii=l.RecordCount
If ii>100 Then ii=100 '最多输出100条
For j=1 To ii
iRtn=iRtn & Replace(Replace(subReplace(iii(0),l,oAtt("name")),"{@"&oAtt("name")&".@index}",j),"@"&oAtt("name")&".@index",j)
l.MoveNext
If l.EOF Then Exit For
Next
End If
iRtn=analyTpl(iRtn)
End If
End If
Case Else
iRtn="{"
End Select
'sCont= Replace(sCont,"{"&sLbl&"}"&sTmp&"{/"&sTag&"}",iRtn)
sCont= Left(sCont,i-1)& Replace(sCont,"{"&sLbl&"}"&sTmp&"{/"&sTag&"}",iRtn,i,1)
i=i+Len(iRtn)
Else
i=i+Len(sLabel)+1
End If
i=InStr(i,sCont,"{")
Loop
analyTpl=sCont
End Function

'获取obj健值
Private Function getValue(sObj,sKey,sFlt)
getValue=""
Select Case sObj
Case "query"
getValue=Request.QueryString(sKey)
Case "form"
getValue=Request.Form(sKey)
Case "cookie"
getValue=Request.Cookies(sKey)
Case "server"
getValue=Request.ServerVariables(sKey)
Case "session"
getValue=Session(sKey)
Case Else
If oData.Exists(sObj) Then
If oType(sObj)=2 Then
If oData(sObj).Exists(sKey) Then getValue=oData(sObj)(sKey)
ElseIf oType(sObj)=4 Then
getValue=oData(sObj)(sKey)
ElseIf oType(sObj)=3 Then
If Not IsEmpty(oData(sObj)(sKey)) Then getValue=oData(sObj)(sKey)
End If
End If
End Select
If IsNull(getValue) Then getValue=""
If sFlt<>"" Then
getValue=fmtVar(getValue,sFlt)
End If
End Function

'替换obj值
Private Function subReplace(ByVal Tpl,obj,oName)
Dim oMth,Match
oReg.Pattern="{@"& oName &".([wd]+)((?:|["& sFmt &"]+)*)?}"
Set oMth=oReg.Execute(Tpl)
For Each Match In oMth
If Match.SubMatches.Count<2 Then
Tpl=Replace(Tpl,Match.Value,obj(Match.SubMatches(0)))
Else
Tpl=Replace(Tpl,Match.Value,fmtVar(obj(Match.SubMatches(0)),Match.SubMatches(1)))
End If
Next
'替换标签内变量
oReg.Pattern="{[^{]+@"& oName &".([wd]+)[^}]*}"
Set oMth=oReg.Execute(Tpl)
For Each Match In oMth
Tpl=Replace(Tpl,Match.Value,_
Replace(Match.Value,"@"&oName&"."&Match.SubMatches(0),_
obj(Match.SubMatches(0))))
Next
subReplace=Tpl
End Function

'判断if条件
Private Function judge(str)
Dim oMth,a,b,c
judge=True
oReg.Pattern="^s*([wd]*)s*(=|<|>|>=|<=|<>|!=|==)s*([wd]*)s*$"
Set oMth=oReg.Execute(str)
If oMth.Count<1 Then
judge=CBol(str)
Else
a=oMth(0).SubMatches(0)
b=oMth(0).SubMatches(1)
c=oMth(0).SubMatches(2)
If (IsNumeric(a) Or a="") And (IsNumeric(c) Or c="") Then
a=parseInt(a)
c=ParseInt(c)
End If
Select Case b
Case "=","=="
If a<>c Then judge=False
Case "<>","!="
If a=c Then judge=False
Case ">"
If a<=c Then judge=False
Case "<"
If a>=c Then judge=False
Case ">="
If a<c Then judge=False
Case "<="
If a>c Then judge=False
End Select
End If
End Function

'格式化变量
Private Function fmtVar(var,fmt)
Dim iTmp,d,f
iTmp=Split(fmt&"|||||","|")
fmtVar=var
Select Case LCase(iTmp(1))
Case "fmtdate" '格式化日期"YYYY"
If IsDate(var) Then
d=CDate(var)
If LCase(iTmp(2))="kindly" Then
f = Replace(LCase(iTmp(2)),"kindly",FmtTime(d,False))
Else
f = Replace(LCase(iTmp(2)),"yyyy",Year(d))
f = Replace(f, "yy", Right(Year(d),2))
f = Replace(f, "mm", Right("00"&Month(d),2))
f = Replace(f, "m", Month(d))
f = Replace(f, "dd", Right("00"&Day(d),2))
f = Replace(f, "d", Day(d))
f = Replace(f, "hh", Right("00"&Hour(d),2))
f = Replace(f, "h", Hour(d))
f = Replace(f, "nn", Right("00"&Minute(d),2))
f = Replace(f, "n", Minute(d))
f = Replace(f, "ss", Right("00"&Second(d),2))
f = Replace(f, "s", Second(d))
f = Replace(f, "www", weekdayname(weekday(d)))
f = Replace(f, "ww", Right(weekdayname(weekday(d)),1))
f = Replace(f, "w", weekday(d))
End If
fmtVar=f
End If
Case "cutstr"
d=parseInt(iTmp(2))
fmtVar=CutString(fmtVar,d,iTmp(3))
Case "lcase"
fmtVar=LCase(fmtVar)
Case "ucase"
fmtVar=UCase(fmtVar)
Case "fmtnum"
iTmp(3)=ParseInt(iTmp(3))
If iTmp(2)="1" Then
fmtVar=parseInt(fmtVar)
If iTmp(3)=0 Or (iTmp(3)<Len(fmtVar) And CBol(iTmp(4))) Then iTmp(3)=Len(fmtVar)
fmtVar=Right(String("0",iTmp(3))&fmtVar,iTmp(3))
ElseIf iTmp(2)="2" Then
If iTmp(3)=0 Or (iTmp(3)<Len(fmtVar) And CBol(iTmp(4))) Then iTmp(3)=Len(fmtVar)
fmtVar=Left(fmtVar&String("0",iTmp(3)),iTmp(3))
ElseIf iTmp(2)="3" Then
fmtVar=Hex(parseInt(fmtVar))
If iTmp(3)=0 Or (iTmp(3)<Len(fmtVar) And CBol(iTmp(4))) Then iTmp(3)=Len(fmtVar)
fmtVar=Right(String("0",iTmp(3))&fmtVar,iTmp(3))
ElseIf iTmp(2)="4" Then
fmtVar=dHex(fmtVar)
If iTmp(3)=0 Or (iTmp(3)<Len(fmtVar) And CBol(iTmp(4))) Then iTmp(3)=Len(fmtVar)
fmtVar=Right(String("0",iTmp(3))&fmtVar,iTmp(3))
End If
Case "nohtml"
fmtVar=ReplaceTag(fmtVar)
Case "html"
fmtVar=HTMDecode(fmtVar)
Case "ubb"
fmtVar=UBBCode(fmtVar)
Case "escape"
fmtVar=URLEncode(fmtVar)
Case "unescape"
fmtVar=URLDecode(fmtVar)
Case "jscode"
fmtVar=UTFEncode(fmtVar)
Case "replace"
fmtVar=Replace(fmtVar,iTmp(2)&"",iTmp(3)&"")
Case "trip"
fmtVar=html2txt(fmtVar)
Case "filesize"
fmtVar=convertSize(fmtVar)
Case "url"
fmtVar=HTMDecode(fmtVar)
Case "default"
If fmtVar="" Or IsEmpty(fmtVar) Or IsNull(fmtVar) Then fmtVar=iTmp(2)
Case "iif"
If CBol(fmtVar) Then
fmtVar=iTmp(2)
Else
fmtVar=iTmp(3)
End If
End Select
If IsNull(fmtVar) Then fmtVar=""
End Function

'解析标签属性
Private Function analyLabel(sCont)
Dim oTag,oMatch,oMth
Set oTag=Server.CreateObject("Scripting.Dictionary")
oReg.Pattern="b([wd]+)s*=s*(['""]?)([wd-,.s=<>$]+)2"
Set oMatch=oReg.Execute(sCont)
For Each oMth In oMatch
If Not oTag.Exists(oMth.SubMatches(0)) Then
oTag.Add oMth.SubMatches(0),oMth.SubMatches(2)
End If
Next
Set analyLabel=oTag
Set oMatch=Nothing
End Function

Private Function CheckPath(fPath)
On Error Resume Next
Dim path,i,cpath
cpath=""
path=Split(Replace(Server.MapPath(fpath),"","/"),"/")
For i=0 To Ubound(path)
If cPath="" Then
cPath=path(i)
Else
cPath=cPath & "/" & path(i)
End If
If Not oFso.FolderExists(cPath) Then
oFso.CreateFolder(cPath)
End If
If Err Then
Err.Clear
cErr 31
CheckPath=False
End If
Next
CheckPath=True
End Function

Private Function vType(obj)
Select Case TypeName(obj)
Case "Recordset"
vType=3
Case "Dictionary"
vType=2
Case "Variant()"
vType=1
Case Else
If VarType(obj)=9 Then
vType=4
Else
vType=0
End If
End Select
End Function

Private Sub cErr(Num)
If IsNumeric(Num) Then
Select Case Num
Case 1:Die "模板不存在"
Case 2:Die "标签不匹配"
Case 3:Die "标签未闭合"
Case 4:Die "标签嵌套错误"
Case 12:Die "if标签未闭合"
Case 13:Die "loop标签未闭合"
Case 14:Die "sql标签未闭合"
Case 15:Die "nocache标签未闭合"
Case 16:Die "cache标签未闭合"
Case 31:Die "创建文件夹失败,请检查权限"
Case 32:Die "清除缓存失败,请检查权限"
Case Else:Die "未知错误"
End Select
Else
Die Num&"标签未闭合"
End If
End Sub
End Class

¥ 打赏
×
如果您觉得文章帮助了您就打赏一下吧
非常感谢你的打赏,我们将继续分享更多优质内容,让我们一起创建更加美好的网络世界!

支付宝扫一扫打赏

微信扫一扫打赏

本文《ASP模板引擎实现(ASP网页静态化)》发布于石头博客文章,作者:admin,如若转载,请注明出处:https://www.pweb123.com/html/asp/169.html,否则禁止转载,谢谢配合!

文章点评

我来说两句 已有0条评论
点击图片更换

添加微信好友

添加微信好友

微信小程序

百度小程序