<%'转发或修改时,请务必保留注释说明.' ____ __ ' ___ / / / / ' | | / / / / 领 ' | | / / / / ' | | / // / 星 ' | | _ / // / ' | || | / / / / 动 ' | || | / / / / ' | || | /_/ /___/ 网 ' | || |___ ' |___||_____| 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_"&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 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 & 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() 'TODO:第一次使用区块时才调用 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, 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, s2) If i3 > 0 Then b2 = i3 i3 = i3 + l2 p = i3 BlockCode()="Dim " & gloTplBK & s1 & vbCrLf & gloTplBK & s1 & "=" & MLine(Mid(s, b2 - b1)) & vbCrLf & "Dim " & gloTplBK1 & s1 & " : Set " & gloTplBK1 & s1 & "=New clsLxxTPLStrCat" & vbCrLf unTplBK()=gloTplBK & s1 & "=Empty: Set " & gloTplBK1 & s1 & "=Nothing"&vbCrLf reTplBK()=gloTplBK1 & s1 & ".Reset"&vbCrLf 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 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(s) On Error Resume Next Init=True tplStore=s tplSubs=Split(s,"<!--/*ExtraSubLevel*/-->") tplStore1=tplSubs(0) If Len(tplStore1)=0 Then Init=False:Exit Function curTpl=tplStore1 IngTpl=curTpl curBk="" curBkL=0 NoBlocked=True End Function Public Function LoadFile(FilePath) LoadFile=Init(GetFile(filepath)) End Function Public Function LoadStr(tplContent) LoadStr=True If Len(tplContent)>0 Then LoadStr=Init(tplContent) 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,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,1) If p1>0 Then p2=InStr(p1+lf1,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="&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 IsNull(val) Then val="" If curBkL>0 Then IngTpl = Replace(IngTpl, vrM1 & k & vrM2, val) Else curTpl = Replace(curTpl, val) End If End Property '用于判断标签是否存在 Public Default Property Get Tag(k) Tag = InStr(1,tplStore,vrM1 & k & vrM2) End Property Public Sub Add() On Error Resume Next If curBkL > 0 Then Execute gloTplBK1&curBk&"()=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="&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, vs(i)) Next End If Execute gloTplBK1&curBk&"()=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 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA End ClassClass 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 SubEnd Class%>
