您所在位置：主题：[原创]高性能单层循环模板类
pk4321
[专家分：690] 发布于 2007-04-22 11:29:00
性能对比测试:
[URL=http://kynzing.s001.51pc.org.cn/test/1.asp]【旧的支持多层嵌套的模板类测试】[/URL]
[URL=http://kynzing.s001.51pc.org.cn/test/2.asp]【新的高性能单层循环模板类测试】[/URL]
[quote]
<%
'转发或修改时,请务必保留注释说明.
' ____ __
' ___ \ \ / /
' | | \ \ / / 领
' | | \ \ / /
' | | \ // / 星
' | | _ / // \
' | || | / / \ \ 动
' | || | / / \ \
' | || | /_/ \___\ 网
' | || |___
' |___||_____| www.lxasp.com
'
'版权所有.使用时请联系告知原作者.
'############################################################
'* 名称: 高性能单层循环模板类
'* 说明:
'* 日期: 2007-4-20 状态: 就绪
'############################################################
Class clsLxTPL
Private vrM1,vrM2
Private bkM1,bkM2,bkM3,bkN1,bkN2
Private bkM_1,bkM_2,bkM_3,bkN_1,bkN_2
Private gloTplBK,gloTplBK1,unTplBK
Private tplStore,tplStore1,BlockCode,curTpl,IngTpl,curBk,curBkL,bkNames
Private Sub Class_Initialize()
tplStore=""
tplStore1=""
curTpl=""
IngTpl=""
curBk=""
curBkL=0
Set unTplBK=New clsLxTPLStrCat
Set bkNames=New clsLxTPLStrCat
Set BlockCode=New clsLxTPLStrCat
gloTplBK="tmp_"&RndGenerator(3)&"_"
gloTplBK1="res_"&RndGenerator(3)&"_"
'设置普通标签符号
vrM1="{="
vrM2="}"
'设置区块标签符号
bkM1="{%[ "
bkM2=" %}"
bkM3="{%] "
bkN1="{%["
bkN2="{%]"
bkM_1=Len(bkM1)
bkM_2=Len(bkM2)
bkM_3=Len(bkM3)
bkN_1=Len(bkN1)
bkN_2=Len(bkN2)
End Sub
Private Sub Class_Terminate()
On Error Resume Next
tplStore=""
tplStore1=""
curTpl=""
IngTpl=""
curBk=""
Execute unTplBK
End Sub
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'模板文件加载、获取、处理过程
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Private Function RndGenerator(Length)
Dim i, tempS
tempS = "abcdefghijklmnopqrstuvwxyz"
RndGenerator = ""
For i = 1 To Length
Randomize
RndGenerator = RndGenerator & Mid(tempS, Int((Len(tempS) * Rnd) + 1), 1)
Next
End Function
Private Function MLine(src)
Dim s
s = src
s = Replace(s, """", """""")
s = Replace(s, vbCrLf, """ & vbCrLf & """)
s = Replace(s, vbCr, """ & vbCr & """)
s = Replace(s, vbLf, """ & vbLf & """)
s = Replace(s, vbTab, """ & vbTab & """)
MLine = """" & s & """"
End Function
Private Function FindBlock(s)
On Error Resume Next
Dim i1, i2, i3
Dim s1, s2, l1, l2, b1, b2
Dim p,o
p=1
o=s
Do
i1 = InStr(p, s, bkM1)
If i1 > 0 Then
i1 = i1 + bkM_1
p = i1
i2 = InStr(i1, s, bkM2)
If i2 > 0 Then
l1 = i2 - i1
If l1 >= 1 And l1 <= 20 Then
s1 = Mid(s, i1, l1)
b1 = i2 + bkM_2
p = b1
s2=bkM3 & s1 & bkM2
l2=Len(s2)
i3 = InStr(b1, s, s2)
If i3 > 0 Then
b2 = i3
i3 = i3 + l2
p = i3
BlockCode()="Dim " & gloTplBK & s1 & vbCrLf & gloTplBK & s1 & "=" & MLine(Mid(s, b1, b2 - b1)) & vbCrLf & "Dim " & gloTplBK1 & s1 & " : Set " & gloTplBK1 & s1 & "=New clsLxTPLStrCat" & vbCrLf
unTplBK()=gloTplBK & s1 & "=Empty: Set " & gloTplBK1 & s1 & "=Nothing"
bkNames()="curTpl=Replace(curTpl,""" & bkN1 & s1 & bkN2 & """," & gloTplBK1 & s1 & "() )" & vbCrLf
o=Replace(o,Mid(s,(i1-bkM_1),(i3)-(i1-bkM_1)),bkN1 & s1 & bkN2 )
End If
End If
Else
l1 = 0
End If
End If
Loop While i1 > 0
FindBlock=o
ExecuteGlobal BlockCode()
End Function
Private Function GetFile(fn)
Dim FSO,ts
On Error Resume Next
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
If Len(Trim(fn))>0 Then
If FSO.FileExists(Server.MapPath(fn)) Then
Set ts = FSO.OpenTextFile(Server.MapPath(fn))
GetFile=ts.ReadAll
ts.Close
Set ts = Nothing
Else
GetFile=Null
End If
Else
GetFile=Null
End If
Set FSO = Nothing
End Function
Public Function LoadFile(FilePath)
LoadFile=True
tplStore=GetFile(filepath)
If IsNull(tplStore) Then LoadFile=False:Exit Function
curTpl=FindBlock(tplStore)
tplStore1=curTpl
IngTpl=curTpl
curBk=""
curBkL=0
End Function
Public Function LoadStr(tplContent)
LoadStr=True
If Len(tplContent)>0 Then
tplStore=tplContent
curTpl=FindBlock(tplStore)
tplStore1=curTpl
IngTpl=curTpl
curBk=""
curBkL=0
Else
LoadStr=False
End If
End Function
Public Function Reset()
Reset=False
If Len(tplStore)>0 And Len(tplStore1)>0 Then
curTpl=tplStore1
IngTpl=curTpl
curBk=""
curBkL=0
Reset=True
End If
End Function
Public Function GetTemplate()
GetTemplate=tplStore
End Function
'用于判断区块是否存在
Public Function Exists(Key)
Exists=(InStr(1,tplStore1,bkN1 & Key & bkN2) > 0)
End Function
Public Function GetParam(pname,def)
Dim qs,p1,p2,pn,sf1,sf2,lf1,lf2
qs=tplStore
pn=""
GetParam=""
sf1="<!--" & pname & "="
lf1=Len(sf1)
sf2="-->"
lf2=Len(sf2)
p1=InStr(1,qs,sf1,1)
If p1>0 Then
p2=InStr(p1+lf1,qs,sf2)
If p2>0 Then
pn=Mid(qs,p1+lf1,p2-(p1+lf1))
End If
End If
GetParam=pn
If Len(GetParam)=0 Then GetParam=def
If IsNumeric(pn) Then GetParam=CInt(pn)
End Function
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'设置要替换的模板中的特殊标签·主要调用过程
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Public Sub Go(k)
On Error Resume Next
Execute "IngTpl="&gloTplBK&k
If Err Then
IngTpl=curTpl
curBk=""
curBkL=0
Err.Clear
Else
curBk=k
curBkL=Len(k)
End If
End Sub
Public Property Let Tag(k, val)
If curBkL>0 Then
IngTpl = Replace(IngTpl, vrM1 & k & vrM2, val)
Else
curTpl = Replace(curTpl, vrM1 & k & vrM2, val)
End If
End Property
'用于判断标签是否存在
Public Default Property Get Tag(k)
Tag = InStr(1,tplStore,vrM1 & k & vrM2)
End Property
Public Sub Add()
Execute gloTplBK1&curBk&"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
Public Sub Rep(b,ks,vs)
Dim i,u
On Error Resume Next
Execute "IngTpl="&gloTplBK&b
If Err Then
IngTpl=curTpl
curBk=""
curBkL=0
Err.Clear
Else
curBk=b
curBkL=Len(b)
End If
u=UBound(ks)
If curBkL>0 Then
For i=0 To u
IngTpl = Replace(IngTpl, vrM1 & ks(i) & vrM2, vs(i))
Next
Else
For i=0 To u
curTpl = Replace(curTpl, vrM1 & ks(i) & vrM2, vs(i))
Next
End If
Execute gloTplBK1&curBk&"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'生成输出处理完成后的结果
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Public Function GetOutput()
On Error Resume Next
Execute bkNames()
GetOutput=curTpl
End Function
Public Function Text()
On Error Resume Next
Execute bkNames()
Text=curTpl
End Function
Public Function HTML()
On Error Resume Next
Execute bkNames()
HTML=curTpl
End Function
Public Sub Pump()
On Error Resume Next
Execute bkNames()
Response.Write curTpl
End Sub
End Class
Class clsLxTPLStrCat
Private aFStrings()
Private iFSPos,iFSLen,iFSIncr
Private Sub Class_Initialize()
iFSPos = 0
iFSIncr = 1000
iFSLen = iFSIncr
ReDim aFStrings(iFSLen)
End Sub
Private Sub Class_Terminate()
Erase aFStrings
End Sub
Public Property Let Item(ByRef sData)
If iFSPos > iFSLen Then
iFSLen = iFSPos + iFSIncr
ReDim Preserve aFStrings(iFSLen)
End If
aFStrings(iFSPos) = sData
iFSPos = iFSPos + 1
End Property
Public Default Property Get Item()
Item = Join(aFStrings, "")
End Property
End Class
%>
[/quote]
使用示例:
[quote]
<!--#INCLUDE FILE="clsLxTPL.asp"-->
<%
Dim a,i,o,startime
startime=Timer
Set a=New clsLxTPL
a.LoadFile "tpl_src.htm"
'不在区块中的标签可以先替换
a("title")="高性能单层循环模板类(新)"
a("var2")="版权所有 领星动网 www.lxasp.com (200704)"
a.Go "blockA"
a("var1")="T1"
a("var2")="T2"
a.Add
'另外一中使用方法:
'For i=1000 To 1 Step -1
' a.Rep "blockB",Array("var1","var2"),Array(i,i)
'Next
For i=1000 To 1 Step -1
a.Go "blockB"
a("var1")=i
a("var2")=i
a.Add
Next
a.Text '区块生成后再统一替换公共标签
a("pub")="color:blue"
a("var1")=FormatNumber((Timer-startime)*1000,3)
o=a.Text
Response.Write o
Set a=Nothing
%>
[/quote]
模板文件:
[quote]
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" >
<title>{=title}</title>
</head>
<body>
{=var1}
<table width="100%" border="1">
{%[ blockA %} <tr>
<th>{=var1}</th>
<th>{=var2}</th>
</tr>
{%] blockA %}
{%[ blockB %} <tr style="{=pub}">
<td>{=var1}</td>
<td>{=var2}</td>
</tr>
{%] blockB %}
</table>
{=var2}
</body>
</html>
[/quote]
[URL=http://kynzing.s001.51pc.org.cn/test/1.asp]【旧的支持多层嵌套的模板类测试】[/URL]
[URL=http://kynzing.s001.51pc.org.cn/test/2.asp]【新的高性能单层循环模板类测试】[/URL]
[quote]
<%
'转发或修改时,请务必保留注释说明.
' ____ __
' ___ \ \ / /
' | | \ \ / / 领
' | | \ \ / /
' | | \ // / 星
' | | _ / // \
' | || | / / \ \ 动
' | || | / / \ \
' | || | /_/ \___\ 网
' | || |___
' |___||_____| www.lxasp.com
'
'版权所有.使用时请联系告知原作者.
'############################################################
'* 名称: 高性能单层循环模板类
'* 说明:
'* 日期: 2007-4-20 状态: 就绪
'############################################################
Class clsLxTPL
Private vrM1,vrM2
Private bkM1,bkM2,bkM3,bkN1,bkN2
Private bkM_1,bkM_2,bkM_3,bkN_1,bkN_2
Private gloTplBK,gloTplBK1,unTplBK
Private tplStore,tplStore1,BlockCode,curTpl,IngTpl,curBk,curBkL,bkNames
Private Sub Class_Initialize()
tplStore=""
tplStore1=""
curTpl=""
IngTpl=""
curBk=""
curBkL=0
Set unTplBK=New clsLxTPLStrCat
Set bkNames=New clsLxTPLStrCat
Set BlockCode=New clsLxTPLStrCat
gloTplBK="tmp_"&RndGenerator(3)&"_"
gloTplBK1="res_"&RndGenerator(3)&"_"
'设置普通标签符号
vrM1="{="
vrM2="}"
'设置区块标签符号
bkM1="{%[ "
bkM2=" %}"
bkM3="{%] "
bkN1="{%["
bkN2="{%]"
bkM_1=Len(bkM1)
bkM_2=Len(bkM2)
bkM_3=Len(bkM3)
bkN_1=Len(bkN1)
bkN_2=Len(bkN2)
End Sub
Private Sub Class_Terminate()
On Error Resume Next
tplStore=""
tplStore1=""
curTpl=""
IngTpl=""
curBk=""
Execute unTplBK
End Sub
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'模板文件加载、获取、处理过程
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Private Function RndGenerator(Length)
Dim i, tempS
tempS = "abcdefghijklmnopqrstuvwxyz"
RndGenerator = ""
For i = 1 To Length
Randomize
RndGenerator = RndGenerator & Mid(tempS, Int((Len(tempS) * Rnd) + 1), 1)
Next
End Function
Private Function MLine(src)
Dim s
s = src
s = Replace(s, """", """""")
s = Replace(s, vbCrLf, """ & vbCrLf & """)
s = Replace(s, vbCr, """ & vbCr & """)
s = Replace(s, vbLf, """ & vbLf & """)
s = Replace(s, vbTab, """ & vbTab & """)
MLine = """" & s & """"
End Function
Private Function FindBlock(s)
On Error Resume Next
Dim i1, i2, i3
Dim s1, s2, l1, l2, b1, b2
Dim p,o
p=1
o=s
Do
i1 = InStr(p, s, bkM1)
If i1 > 0 Then
i1 = i1 + bkM_1
p = i1
i2 = InStr(i1, s, bkM2)
If i2 > 0 Then
l1 = i2 - i1
If l1 >= 1 And l1 <= 20 Then
s1 = Mid(s, i1, l1)
b1 = i2 + bkM_2
p = b1
s2=bkM3 & s1 & bkM2
l2=Len(s2)
i3 = InStr(b1, s, s2)
If i3 > 0 Then
b2 = i3
i3 = i3 + l2
p = i3
BlockCode()="Dim " & gloTplBK & s1 & vbCrLf & gloTplBK & s1 & "=" & MLine(Mid(s, b1, b2 - b1)) & vbCrLf & "Dim " & gloTplBK1 & s1 & " : Set " & gloTplBK1 & s1 & "=New clsLxTPLStrCat" & vbCrLf
unTplBK()=gloTplBK & s1 & "=Empty: Set " & gloTplBK1 & s1 & "=Nothing"
bkNames()="curTpl=Replace(curTpl,""" & bkN1 & s1 & bkN2 & """," & gloTplBK1 & s1 & "() )" & vbCrLf
o=Replace(o,Mid(s,(i1-bkM_1),(i3)-(i1-bkM_1)),bkN1 & s1 & bkN2 )
End If
End If
Else
l1 = 0
End If
End If
Loop While i1 > 0
FindBlock=o
ExecuteGlobal BlockCode()
End Function
Private Function GetFile(fn)
Dim FSO,ts
On Error Resume Next
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
If Len(Trim(fn))>0 Then
If FSO.FileExists(Server.MapPath(fn)) Then
Set ts = FSO.OpenTextFile(Server.MapPath(fn))
GetFile=ts.ReadAll
ts.Close
Set ts = Nothing
Else
GetFile=Null
End If
Else
GetFile=Null
End If
Set FSO = Nothing
End Function
Public Function LoadFile(FilePath)
LoadFile=True
tplStore=GetFile(filepath)
If IsNull(tplStore) Then LoadFile=False:Exit Function
curTpl=FindBlock(tplStore)
tplStore1=curTpl
IngTpl=curTpl
curBk=""
curBkL=0
End Function
Public Function LoadStr(tplContent)
LoadStr=True
If Len(tplContent)>0 Then
tplStore=tplContent
curTpl=FindBlock(tplStore)
tplStore1=curTpl
IngTpl=curTpl
curBk=""
curBkL=0
Else
LoadStr=False
End If
End Function
Public Function Reset()
Reset=False
If Len(tplStore)>0 And Len(tplStore1)>0 Then
curTpl=tplStore1
IngTpl=curTpl
curBk=""
curBkL=0
Reset=True
End If
End Function
Public Function GetTemplate()
GetTemplate=tplStore
End Function
'用于判断区块是否存在
Public Function Exists(Key)
Exists=(InStr(1,tplStore1,bkN1 & Key & bkN2) > 0)
End Function
Public Function GetParam(pname,def)
Dim qs,p1,p2,pn,sf1,sf2,lf1,lf2
qs=tplStore
pn=""
GetParam=""
sf1="<!--" & pname & "="
lf1=Len(sf1)
sf2="-->"
lf2=Len(sf2)
p1=InStr(1,qs,sf1,1)
If p1>0 Then
p2=InStr(p1+lf1,qs,sf2)
If p2>0 Then
pn=Mid(qs,p1+lf1,p2-(p1+lf1))
End If
End If
GetParam=pn
If Len(GetParam)=0 Then GetParam=def
If IsNumeric(pn) Then GetParam=CInt(pn)
End Function
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'设置要替换的模板中的特殊标签·主要调用过程
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Public Sub Go(k)
On Error Resume Next
Execute "IngTpl="&gloTplBK&k
If Err Then
IngTpl=curTpl
curBk=""
curBkL=0
Err.Clear
Else
curBk=k
curBkL=Len(k)
End If
End Sub
Public Property Let Tag(k, val)
If curBkL>0 Then
IngTpl = Replace(IngTpl, vrM1 & k & vrM2, val)
Else
curTpl = Replace(curTpl, vrM1 & k & vrM2, val)
End If
End Property
'用于判断标签是否存在
Public Default Property Get Tag(k)
Tag = InStr(1,tplStore,vrM1 & k & vrM2)
End Property
Public Sub Add()
Execute gloTplBK1&curBk&"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
Public Sub Rep(b,ks,vs)
Dim i,u
On Error Resume Next
Execute "IngTpl="&gloTplBK&b
If Err Then
IngTpl=curTpl
curBk=""
curBkL=0
Err.Clear
Else
curBk=b
curBkL=Len(b)
End If
u=UBound(ks)
If curBkL>0 Then
For i=0 To u
IngTpl = Replace(IngTpl, vrM1 & ks(i) & vrM2, vs(i))
Next
Else
For i=0 To u
curTpl = Replace(curTpl, vrM1 & ks(i) & vrM2, vs(i))
Next
End If
Execute gloTplBK1&curBk&"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'生成输出处理完成后的结果
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Public Function GetOutput()
On Error Resume Next
Execute bkNames()
GetOutput=curTpl
End Function
Public Function Text()
On Error Resume Next
Execute bkNames()
Text=curTpl
End Function
Public Function HTML()
On Error Resume Next
Execute bkNames()
HTML=curTpl
End Function
Public Sub Pump()
On Error Resume Next
Execute bkNames()
Response.Write curTpl
End Sub
End Class
Class clsLxTPLStrCat
Private aFStrings()
Private iFSPos,iFSLen,iFSIncr
Private Sub Class_Initialize()
iFSPos = 0
iFSIncr = 1000
iFSLen = iFSIncr
ReDim aFStrings(iFSLen)
End Sub
Private Sub Class_Terminate()
Erase aFStrings
End Sub
Public Property Let Item(ByRef sData)
If iFSPos > iFSLen Then
iFSLen = iFSPos + iFSIncr
ReDim Preserve aFStrings(iFSLen)
End If
aFStrings(iFSPos) = sData
iFSPos = iFSPos + 1
End Property
Public Default Property Get Item()
Item = Join(aFStrings, "")
End Property
End Class
%>
[/quote]
使用示例:
[quote]
<!--#INCLUDE FILE="clsLxTPL.asp"-->
<%
Dim a,i,o,startime
startime=Timer
Set a=New clsLxTPL
a.LoadFile "tpl_src.htm"
'不在区块中的标签可以先替换
a("title")="高性能单层循环模板类(新)"
a("var2")="版权所有 领星动网 www.lxasp.com (200704)"
a.Go "blockA"
a("var1")="T1"
a("var2")="T2"
a.Add
'另外一中使用方法:
'For i=1000 To 1 Step -1
' a.Rep "blockB",Array("var1","var2"),Array(i,i)
'Next
For i=1000 To 1 Step -1
a.Go "blockB"
a("var1")=i
a("var2")=i
a.Add
Next
a.Text '区块生成后再统一替换公共标签
a("pub")="color:blue"
a("var1")=FormatNumber((Timer-startime)*1000,3)
o=a.Text
Response.Write o
Set a=Nothing
%>
[/quote]
模板文件:
[quote]
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" >
<title>{=title}</title>
</head>
<body>
{=var1}
<table width="100%" border="1">
{%[ blockA %} <tr>
<th>{=var1}</th>
<th>{=var2}</th>
</tr>
{%] blockA %}
{%[ blockB %} <tr style="{=pub}">
<td>{=var1}</td>
<td>{=var2}</td>
</tr>
{%] blockB %}
</table>
{=var2}
</body>
</html>
[/quote]