您所在位置：主题：[原创]快速单层循环区块模板类
pk4321
[专家分：690] 发布于 2007-04-22 11:28:00
Fast ASP Template Class
[quote]
<%
'转发或修改时,请务必保留注释说明.
' ____ __
' ___ \ \ / /
' | | \ \ / / 领
' | | \ \ / /
' | | \ // / 星
' | | _ / // \
' | || | / / \ \ 动
' | || | / / \ \
' | || | /_/ \___\ 网
' | || |___
' |___||_____| www.lxasp.com
'
'版权所有.使用时请联系告知原作者.
'############################################################
'* 名称: 快速单层循环区块模板类 ( Ver 2.0 )
'* 说明: Fast/High Performance Single-level Blocks ASP Template Class
'* 日期: 2007-4-23 状态: 就绪
'############################################################
Class clsLxxTPL
Private vrM1,vrM2
Private bkM1,bkM2,bkM3,bkN1,bkN2
Private bkM_1,bkM_2,bkM_3,bkN_1,bkN_2
Private gloTplBK,gloTplBK1,unTplBK,reTplBK,tplSubs
Private tplStore,tplStore1,curTpl,IngTpl,curBk,curBkL,bkNames,BlockCode,NoBlocked
Private Sub Class_Initialize()
tplStore=""
tplStore1=""
curTpl=""
IngTpl=""
curBk=""
curBkL=0
NoBlocked=True
Set reTplBK=New clsLxxTPLStrCat
Set unTplBK=New clsLxxTPLStrCat
Set bkNames=New clsLxxTPLStrCat
Set BlockCode=New clsLxxTPLStrCat
gloTplBK="tmp_"&amp;RndGenerator(3)&amp;"_"
gloTplBK1="res_"&amp;RndGenerator(3)&amp;"_"
'设置普通标签符号
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
Set reTplBK=Nothing
Set unTplBK=Nothing
Set bkNames=Nothing
Set BlockCode=Nothing
End Sub
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'模板文件加载、获取、处理过程
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Private Function RndGenerator(Length)
Dim i, tempS
tempS = "abcdefghijklmnopqrstuvwxyz"
RndGenerator = ""
For i = 1 To Length
Randomize
RndGenerator = RndGenerator &amp; 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, """ &amp; vbCrLf &amp; """)
s = Replace(s, vbCr, """ &amp; vbCr &amp; """)
s = Replace(s, vbLf, """ &amp; vbLf &amp; """)
s = Replace(s, vbTab, """ &amp; vbTab &amp; """)
MLine = """" &amp; s &amp; """"
End Function
Private Function FindBlock()
On Error Resume Next
Dim i1, i2, i3
Dim s1, s2, l1, l2, b1, b2
Dim p,o,s
p=1
o=curTpl
s=curTpl
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 &amp; s1 &amp; bkM2
l2=Len(s2)
i3 = InStr(b1, s, s2)
If i3 > 0 Then
b2 = i3
i3 = i3 + l2
p = i3
BlockCode()="Dim " &amp; gloTplBK &amp; s1 &amp; vbCrLf &amp; gloTplBK &amp; s1 &amp; "=" &amp; MLine(Mid(s, b1, b2 - b1)) &amp; vbCrLf &amp; "Dim " &amp; gloTplBK1 &amp; s1 &amp; " : Set " &amp; gloTplBK1 &amp; s1 &amp; "=New clsLxxTPLStrCat" &amp; vbCrLf
unTplBK()=gloTplBK &amp; s1 &amp; "=Empty: Set " &amp; gloTplBK1 &amp; s1 &amp; "=Nothing"&amp;vbCrLf
reTplBK()=gloTplBK1 &amp; s1 &amp; ".Reset"&amp;vbCrLf
bkNames()="curTpl=Replace(curTpl,""" &amp; bkN1 &amp; s1 &amp; bkN2 &amp; """," &amp; gloTplBK1 &amp; s1 &amp; "() )" &amp; vbCrLf
o=Replace(o,Mid(s,(i1-bkM_1),(i3)-(i1-bkM_1)),bkN1 &amp; s1 &amp; bkN2 )
End If
End If
Else
l1 = 0
End If
End If
Loop While i1 > 0
ExecuteGlobal BlockCode()
curTpl=o
tplStore1=curTpl
IngTpl=curTpl
NoBlocked=False
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
Private Function Init()
On Error Resume Next
Init=True
tplStore=tplSubs(0)
If Len(tplStore)=0 Then Init=False:Exit Function
curTpl=tplStore
tplStore1=curTpl
IngTpl=curTpl
curBk=""
curBkL=0
NoBlocked=True
End Function
Public Function LoadFile(FilePath)
LoadFile=True
tplSubs=Split(GetFile(filepath),"<!--/*ExtraSubLevel*/-->")
LoadFile=Init()
End Function
Public Function LoadStr(tplContent)
LoadStr=True
If Len(tplContent)>0 Then
tplSubs=Split(tplContent,"<!--/*ExtraSubLevel*/-->")
LoadStr=Init()
Else
LoadStr=False
End If
End Function
Public Function Reset()
On Error Resume Next
Reset=True
If Len(tplStore1)=0 Then Reset=False:Exit Function
curTpl=tplStore1
IngTpl=curTpl
curBk=""
curBkL=0
NoBlocked=False
Execute reTplBK()
End Function
Public Function GetTemplate()
GetTemplate=tplStore
End Function
Public Function GetSub(idx)
On Error Resume Next
GetSub=""
GetSub=tplSubs(idx)
End Function
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'用于判断区块是否存在
Public Function Exists(Key)
If NoBlocked Then FindBlock
Exists=(InStr(1,tplStore1,bkN1 &amp; Key &amp; bkN2) > 0)
End Function
Public Function GetParam(pname,def)
Dim qs,p1,p2,pn,sf1,sf2,lf1,lf2
qs=tplStore
pn=""
GetParam=""
sf1="<!--" &amp; pname &amp; "="
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
If NoBlocked Then FindBlock
Execute "IngTpl="&amp;gloTplBK&amp;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 &amp; k &amp; vrM2, val)
Else
curTpl = Replace(curTpl, vrM1 &amp; k &amp; vrM2, val)
End If
End Property
'用于判断标签是否存在
Public Default Property Get Tag(k)
Tag = InStr(1,tplStore,vrM1 &amp; k &amp; vrM2)
End Property
Public Sub Add()
On Error Resume Next
If curBkL > 0 Then Execute gloTplBK1&amp;curBk&amp;"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
'这个纯粹是上面属性的过程调用版
Public Sub Rep(b,ks,vs)
Dim i,u
On Error Resume Next
If NoBlocked Then FindBlock
Execute "IngTpl="&amp;gloTplBK&amp;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 &amp; ks(i) &amp; vrM2, vs(i))
Next
Else
For i=0 To u
curTpl = Replace(curTpl, vrM1 &amp; ks(i) &amp; vrM2, vs(i))
Next
End If
Execute gloTplBK1&amp;curBk&amp;"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'生成输出处理完成后的结果
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Public Function GetOutput()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
GetOutput=curTpl
End Function
Public Function Text()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
Text=curTpl
End Function
Public Function HTML()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
HTML=curTpl
End Function
Public Sub Pump()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
Response.Write curTpl
End Sub
End Class
Class clsLxxTPLStrCat
Private aFStrings()
Private iFSPos,iFSLen,iFSIncr
Private Sub Class_Initialize()
Reset
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
Public Sub Reset()
iFSPos = 0
iFSIncr = 100
iFSLen = iFSIncr
ReDim aFStrings(iFSLen)
End Sub
End Class
%>
[/quote]
[quote]
<%
'转发或修改时,请务必保留注释说明.
' ____ __
' ___ \ \ / /
' | | \ \ / / 领
' | | \ \ / /
' | | \ // / 星
' | | _ / // \
' | || | / / \ \ 动
' | || | / / \ \
' | || | /_/ \___\ 网
' | || |___
' |___||_____| www.lxasp.com
'
'版权所有.使用时请联系告知原作者.
'############################################################
'* 名称: 快速单层循环区块模板类 ( Ver 2.0 )
'* 说明: Fast/High Performance Single-level Blocks ASP Template Class
'* 日期: 2007-4-23 状态: 就绪
'############################################################
Class clsLxxTPL
Private vrM1,vrM2
Private bkM1,bkM2,bkM3,bkN1,bkN2
Private bkM_1,bkM_2,bkM_3,bkN_1,bkN_2
Private gloTplBK,gloTplBK1,unTplBK,reTplBK,tplSubs
Private tplStore,tplStore1,curTpl,IngTpl,curBk,curBkL,bkNames,BlockCode,NoBlocked
Private Sub Class_Initialize()
tplStore=""
tplStore1=""
curTpl=""
IngTpl=""
curBk=""
curBkL=0
NoBlocked=True
Set reTplBK=New clsLxxTPLStrCat
Set unTplBK=New clsLxxTPLStrCat
Set bkNames=New clsLxxTPLStrCat
Set BlockCode=New clsLxxTPLStrCat
gloTplBK="tmp_"&amp;RndGenerator(3)&amp;"_"
gloTplBK1="res_"&amp;RndGenerator(3)&amp;"_"
'设置普通标签符号
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
Set reTplBK=Nothing
Set unTplBK=Nothing
Set bkNames=Nothing
Set BlockCode=Nothing
End Sub
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'模板文件加载、获取、处理过程
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Private Function RndGenerator(Length)
Dim i, tempS
tempS = "abcdefghijklmnopqrstuvwxyz"
RndGenerator = ""
For i = 1 To Length
Randomize
RndGenerator = RndGenerator &amp; 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, """ &amp; vbCrLf &amp; """)
s = Replace(s, vbCr, """ &amp; vbCr &amp; """)
s = Replace(s, vbLf, """ &amp; vbLf &amp; """)
s = Replace(s, vbTab, """ &amp; vbTab &amp; """)
MLine = """" &amp; s &amp; """"
End Function
Private Function FindBlock()
On Error Resume Next
Dim i1, i2, i3
Dim s1, s2, l1, l2, b1, b2
Dim p,o,s
p=1
o=curTpl
s=curTpl
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 &amp; s1 &amp; bkM2
l2=Len(s2)
i3 = InStr(b1, s, s2)
If i3 > 0 Then
b2 = i3
i3 = i3 + l2
p = i3
BlockCode()="Dim " &amp; gloTplBK &amp; s1 &amp; vbCrLf &amp; gloTplBK &amp; s1 &amp; "=" &amp; MLine(Mid(s, b1, b2 - b1)) &amp; vbCrLf &amp; "Dim " &amp; gloTplBK1 &amp; s1 &amp; " : Set " &amp; gloTplBK1 &amp; s1 &amp; "=New clsLxxTPLStrCat" &amp; vbCrLf
unTplBK()=gloTplBK &amp; s1 &amp; "=Empty: Set " &amp; gloTplBK1 &amp; s1 &amp; "=Nothing"&amp;vbCrLf
reTplBK()=gloTplBK1 &amp; s1 &amp; ".Reset"&amp;vbCrLf
bkNames()="curTpl=Replace(curTpl,""" &amp; bkN1 &amp; s1 &amp; bkN2 &amp; """," &amp; gloTplBK1 &amp; s1 &amp; "() )" &amp; vbCrLf
o=Replace(o,Mid(s,(i1-bkM_1),(i3)-(i1-bkM_1)),bkN1 &amp; s1 &amp; bkN2 )
End If
End If
Else
l1 = 0
End If
End If
Loop While i1 > 0
ExecuteGlobal BlockCode()
curTpl=o
tplStore1=curTpl
IngTpl=curTpl
NoBlocked=False
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
Private Function Init()
On Error Resume Next
Init=True
tplStore=tplSubs(0)
If Len(tplStore)=0 Then Init=False:Exit Function
curTpl=tplStore
tplStore1=curTpl
IngTpl=curTpl
curBk=""
curBkL=0
NoBlocked=True
End Function
Public Function LoadFile(FilePath)
LoadFile=True
tplSubs=Split(GetFile(filepath),"<!--/*ExtraSubLevel*/-->")
LoadFile=Init()
End Function
Public Function LoadStr(tplContent)
LoadStr=True
If Len(tplContent)>0 Then
tplSubs=Split(tplContent,"<!--/*ExtraSubLevel*/-->")
LoadStr=Init()
Else
LoadStr=False
End If
End Function
Public Function Reset()
On Error Resume Next
Reset=True
If Len(tplStore1)=0 Then Reset=False:Exit Function
curTpl=tplStore1
IngTpl=curTpl
curBk=""
curBkL=0
NoBlocked=False
Execute reTplBK()
End Function
Public Function GetTemplate()
GetTemplate=tplStore
End Function
Public Function GetSub(idx)
On Error Resume Next
GetSub=""
GetSub=tplSubs(idx)
End Function
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'用于判断区块是否存在
Public Function Exists(Key)
If NoBlocked Then FindBlock
Exists=(InStr(1,tplStore1,bkN1 &amp; Key &amp; bkN2) > 0)
End Function
Public Function GetParam(pname,def)
Dim qs,p1,p2,pn,sf1,sf2,lf1,lf2
qs=tplStore
pn=""
GetParam=""
sf1="<!--" &amp; pname &amp; "="
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
If NoBlocked Then FindBlock
Execute "IngTpl="&amp;gloTplBK&amp;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 &amp; k &amp; vrM2, val)
Else
curTpl = Replace(curTpl, vrM1 &amp; k &amp; vrM2, val)
End If
End Property
'用于判断标签是否存在
Public Default Property Get Tag(k)
Tag = InStr(1,tplStore,vrM1 &amp; k &amp; vrM2)
End Property
Public Sub Add()
On Error Resume Next
If curBkL > 0 Then Execute gloTplBK1&amp;curBk&amp;"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
'这个纯粹是上面属性的过程调用版
Public Sub Rep(b,ks,vs)
Dim i,u
On Error Resume Next
If NoBlocked Then FindBlock
Execute "IngTpl="&amp;gloTplBK&amp;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 &amp; ks(i) &amp; vrM2, vs(i))
Next
Else
For i=0 To u
curTpl = Replace(curTpl, vrM1 &amp; ks(i) &amp; vrM2, vs(i))
Next
End If
Execute gloTplBK1&amp;curBk&amp;"()=IngTpl"
IngTpl=""
curBk=""
curBkL=0
End Sub
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
'生成输出处理完成后的结果
'VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
Public Function GetOutput()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
GetOutput=curTpl
End Function
Public Function Text()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
Text=curTpl
End Function
Public Function HTML()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
HTML=curTpl
End Function
Public Sub Pump()
On Error Resume Next
If NoBlocked Then FindBlock
Execute bkNames()
Response.Write curTpl
End Sub
End Class
Class clsLxxTPLStrCat
Private aFStrings()
Private iFSPos,iFSLen,iFSIncr
Private Sub Class_Initialize()
Reset
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
Public Sub Reset()
iFSPos = 0
iFSIncr = 100
iFSLen = iFSIncr
ReDim aFStrings(iFSLen)
End Sub
End Class
%>
[/quote]