`
shirne
  • 浏览: 7453 次
  • 性别: Icon_minigender_1
  • 来自: 郑州
社区版块
存档分类
最新评论

ASP模板引擎实现

    博客分类:
  • ASP
阅读更多
模板引擎说明:
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以小时计,省略时永久缓存,除非清除缓存

==============================沧桑的分隔线====================================

以下是解析类的源码
'**********************************
'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	= "\w\d\/\\\-\[\]\.\u00A1-\uFFFF"		'变量格式化允许的字符,不能有}
		iChe	= CACHE_TIME		'缓存时间以秒计
		
		bHtm	= HTML_OPEN		'是否生成静态,生成静态时必须指定filepath
		iQuery	= 0				'自定义的sql查询次数
		
		htmPath	= AppPath&"html/"		'静态文件路径
		chePath	= AppPath&"cache/"		'缓存文件路径
		
		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="\{include\s*\(([\'\""])?([\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,SiteName)
		oReg.Pattern="\{\$SiteTitle\}":sHtm=oReg.Replace(sHtm,SiteTitle)
		oReg.Pattern="\{\$SiteDesc\}":sHtm=oReg.Replace(sHtm,SiteDesc)
		oReg.Pattern="\{\$SiteKeyWords\}":sHtm=oReg.Replace(sHtm,SiteWords)
		oReg.Pattern="\{\$CopyRight\}":sHtm=oReg.Replace(sHtm,CopyRight)
		oReg.Pattern="\{\$SiteURL\}":sHtm=oReg.Replace(sHtm,SiteURL)
		
		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"&SiteName&"$2")
		oReg.Pattern="(\{[^{]+)\$SiteTitle([^}]*\})":sHtm=oReg.Replace(sHtm,"$1"&SiteTitle&"$2")
		oReg.Pattern="(\{[^{]+)\$SiteDesc([^}]*\})":sHtm=oReg.Replace(sHtm,"$1"&SiteDesc&"$2")
		oReg.Pattern="(\{[^{]+)\$SiteKeyWords([^}]*\})":sHtm=oReg.Replace(sHtm,"$1"&SiteWords&"$2")
		oReg.Pattern="(\{[^{]+)\$CopyRight([^}]*\})":sHtm=oReg.Replace(sHtm,"$1"&CopyRight&"$2")
		oReg.Pattern="(\{[^{]+)\$SiteURL([^}]*\})":sHtm=oReg.Replace(sHtm,"$1"&SiteURL&"$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="\{\$([\d\w]+)\.([\d\w]+)((?:\|["& 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="\{[^{]+\$([\d\w]+)\.([\d\w]+)[^}]*\}"
		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)
			ii=InStr(sLabel,":")
			If ii>0 Then	'跳过其它标签
				'标签名
				sTag=Left(sLabel,ii-1)
				If InStr("|if|fn|for|foreach|loop|sql|","|"&sTag&"|")>0 Then
					'标签结束位置
					iEnd=InStr(i,sCont,"{/"&sTag&"}")
					If iEnd <1 Then cErr(3)
					'标签模板
					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 3
						sTemp=Mid(sCont,i+Len(sLabel)+2,iEnd-i-Len(sLabel)-2)
						iDiv=InStr(iDiv+1,sTemp,"{"&sTag&":")
					Loop
					
					'将变量缓存,以防后期被改变
					sTmp=sTemp
					sLbl=sLabel
				End If
				
				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
			If IsNull(getValue) Then getValue=""
		End Select
		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 &"\.([\w\d]+)((?:\|["& 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 &"\.([\w\d]+)[^}]*\}"
		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*([\w\d]*)\s*(\=|\<|\>|\>=|\<=|\<\>|\!\=|\=\=)\s*([\w\d]*)\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 "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([\w\d]+)\s*=\s*(['""])([\w\d\-\,\.\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),decode(oMth.SubMatches(2),False)
			End If
		Next
		Set analyLabel=oTag
		Set oMatch=Nothing
	End Function
	
	Private Function decode(str,deep)
		decode=str
		If InStr(str,"%")<1 Then Exit Function
		decode=Replace(decode,"%22","""")
		decode=Replace(decode,"%27","'")
		If deep Then
			decode=Replace(decode,"%2C",",")
			decode=Replace(decode,"%25","%")
		End If
	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

1
0
分享到:
评论
5 楼 shirne 2011-10-30  
sunwii 写道
来学习的.
代码行90:i=InStr(k,"<nocache>")是否是手误呢??有些看不明白了.

谢谢您读代码这么认真,确实是写错了.
应该是 InStr(k,sHtm,"<nocache>")
4 楼 shirne 2011-10-30  
sunwii 写道
另外,有没有示例的模板文件??可不可以发一份给我参考.谢谢.sunwii@qq.com

不好意思,最近比较忙,有时间我会整理出来,再告诉你.
3 楼 sunwii 2011-10-23  
另外,有没有示例的模板文件??可不可以发一份给我参考.谢谢.sunwii@qq.com
2 楼 sunwii 2011-10-23  
来学习的.
代码行90:i=InStr(k,"<nocache>")是否是手误呢??有些看不明白了.
1 楼 tangranchuxx 2011-09-15  

相关推荐

    ASP.NET 模板引擎 jntemplate C#模板引擎,可以多模板切换

    ASP.NET 模板引擎,如jntemplate,是.NET开发者常用的一种工具,它极大地简化了网页和各种文本生成的工作流程。这种模板引擎的核心思想是将显示逻辑与业务逻辑分离,使得设计人员和开发人员可以各自独立地进行工作,...

    网鸟Asp.Net模板引擎 v4.4

    网鸟Asp.Net模板引擎是基于 C# 语言开发的应用于 Asp.Net 平台的代码分析工具。它可以将指定语法结构的代码模板转换为运行时代码文档以提高您的开发效率,同时也能够强制分离您的代码业务逻辑和用户界面,实现分层...

    ASP源码—网鸟Asp.Net模板引擎 v4.2.zip

    "网鸟Asp.Net模板引擎 v4.2"是一个特定版本的模板引擎,专注于提升开发效率和用户体验。在这个版本中,开发者可以期待一些优化的性能、增强的功能以及可能的bug修复。 在ASP.NET框架中,模板引擎是构建基于MVC...

    Asp.Net模板引擎_aspx开发教程.rar

    在本教程中,"网鸟Asp.Net模板引擎 v2.2.1016.35_ymind.templateengine"可能是一个特定的模板引擎实现,它可能提供了额外的功能或优化,比如更高效的编译方式、更易用的API等。这个版本号暗示了这是一个特定的发布...

    网鸟Asp.Net模板引擎 v4.2

    网鸟Asp.Net模板引擎是基于 C# 语言开发的应用于 Asp.Net 平台的代码分析工具。它可以将指定语法结构的代码模板转换为运行时代码文档以提高您的开发效率,同时也能够强制分离您的代码业务逻辑和用户界面,实现分层...

    YimonTemplate (ASP模板引擎) v1.5.20120823 UTF8

    目前模板化已经不是一项架构必须考虑的条件,像是框架主义者推崇的原生态,像保守派推崇的 smarty,还有一 种新鲜的写法,就是 phpwind 的 (ASP模板引擎)为程序开发配备常用函数及设置,开发中仅需要直接采用即可。...

    asp.net生成静态页面的模板引擎

    Razor视图引擎是ASP.NET MVC中最常用的模板引擎,它的语法简洁且直观。例如,`@`符号用于引入C#代码,`&lt;text&gt;`标签用于包含纯HTML内容,`@foreach`、`@if`等用于控制流程。Razor视图在运行时会被编译成.NET中间语言...

    网鸟Asp.Net模板引擎 v4.2.zip

    网鸟Asp.Net模板引擎是一款专门针对Asp.Net平台开发的高效、易用的模板处理工具,主要用于简化前端代码的编写,提升Web应用的开发效率。版本4.2是其一个重要的更新,可能包含了对先前版本的性能优化、新功能的添加...

    asp.net模板引擎、模板引擎

    ASP.NET 模板引擎是用于动态生成HTML或其他格式文档的工具,它允许开发者使用模板语法来定义页面结构,然后在运行时用数据填充这些模板,从而实现内容与表现的分离。这种技术在Web开发中非常常见,因为它可以提高...

    网鸟Asp.Net模板引擎源码.zip

    【标题】"网鸟Asp.Net模板引擎源码"指的是一个专门为Asp.Net平台设计的模板引擎的开源代码。模板引擎是一种允许开发者使用特定的模板语言来动态生成HTML或其他Web内容的工具。在Asp.Net中,这样的引擎可以帮助开发者...

    ASP 高级模板引擎实现类

    通过对上述代码片段的详细分析,我们可以看出这个ASP模板引擎实现类具有良好的可扩展性和灵活性,能够满足基本的Web开发需求。此外,它还提供了一些实用的功能,如编码设置、路径管理以及分页支持等,这些都是构建高...

    ASP模板引擎Climber

    ASP模板引擎 Climber 1.0.0,这是一个类似于PHP的SMARTY。因为原来的网站是用ASP开发的,为了提高网站的性能,又不想整体换代码语言,以免影响搜索引擎的收录。于是有了自己写一个的想法,在网上搜索了很久,没有能...

    aspnetms. ASP.net模板引擎

    在ASP.NET中,模板引擎主要通过以下几种技术实现: 1. **Razor视图引擎**:Razor是ASP.NET MVC和ASP.NET Core中默认的视图引擎,以其简洁的语法和代码嵌入HTML的能力而著名。它使用`@`符号作为起始标记,允许开发者...

    ASP.NET源码——网鸟Asp.Net模板引擎.zip

    通过学习和研究这个源码,开发者可以深入理解ASP.NET中模板引擎的实现原理,这对于自定义或优化现有模板引擎,或者为自己的项目构建类似功能会非常有帮助。同时,这也是提升.NET开发技能的好机会,尤其是对于那些对...

    TemplateEngin(模板引擎(标签解析)示例源码).

    总的来说,这个压缩包提供了一个完整的示例,展示了如何在ASP.NET环境中实现和使用模板引擎进行动态内容渲染。通过分析`Default.aspx`和`Default.aspx.cs`中的代码,可以了解标签解析的实现细节;同时,研究`web....

    基于ASP的YimonTemplate ASP模板引擎 v1.5.20220823 GBK.zip

    **ASP(Active Server Pages)** 是一...以上就是关于"基于ASP的YimonTemplate ASP模板引擎 v1.5.20220823 GBK"的一些关键知识点和使用建议。通过熟练掌握这些概念和技巧,开发者可以更加高效地构建基于ASP的动态网站。

    模板引擎(标签解析)示例源码

    通过分析这些文件,我们可以了解到这个模板引擎示例可能是用ASP.NET实现的,使用了自定义的标签解析机制,并且提供了演示和说明以便理解和使用。开发者可以通过阅读和研究这些源码,学习如何创建自己的模板引擎,...

    简单实现模板引擎

    本篇文章将详细介绍如何在C#中简单实现一个模板引擎,以及文件流方式处理的相关知识。 首先,我们需要理解模板引擎的基本原理。模板引擎的工作流程是:将HTML模板与数据源(如JSON或数据库)结合,然后生成最终的...

Global site tag (gtag.js) - Google Analytics