ASP模板类[实现一维循环和二维循环，可以从文件、数据库、变量取摸板]

<%
'=========================================================
' File: class_template.asp
' Version:1.0
' Date: 2004-5-7
' Script Written by R.H
' Description: ASP Template Class
'=========================================================
' Copyright (C) 2004 Interflower Studios. All rights reserved.
' Web: http://www.interflower.cn
' Need help? Contact: [email protected]
'=========================================================

'=========================================================
'模板中替换的部分用{{%}}表示
'模板中的循环用<!-- BEGIN % -->开始 <!-- END % -->结束 支持一次嵌套


Class Template
     Private tmp
     Private tpl_dir, tpl, tpl_blk
     Private var_list, blk_list, blk_var_list
     Private re, match, matchs
     Private Sub class_Initialize
           sql = ""
           tpl_dir = "templates/"
           tpl = ""
           blk=""
           Set var_list = Server.CreateObject("Scripting.Dictionary")
           Set blk_list = Server.CreateObject("Scripting.Dictionary")
           Set blk_var_list = Server.CreateObject("Scripting.Dictionary")
           Set re = New RegExp  
     End Sub

'取得主体模板      
'========================

'从变量取出
     Public Sub SetTpl(tplvar)
           tpl = tplvar
     End Sub
     
' 从DB中取出，自己修改sql语句
     Public Sub SetTplDb(tplname)
           Dim sql, rs
           Set rs = Server.CreateObject("ADODB.RecordSet")
           sql = "SELECT content FROM templates WHERE name = '"&tplname&"'"
           rs.Open sql,conn,1,1
           If rs.RecordCount <> 1 Then
                 Response.Write("数据库错误！<br>")
                 Response.End()
           End If
           tpl = rs("content")
           rs.Close
           Set rs = Nothing
     End Sub
     
'从文件取出
     Public Sub SetTplFile(tplfile)
           Dim FSO, oFile
           Set FSO = Server.Createobject("Scripting.FileSystemObject")
           If FSO.FileExists(Server.Mappath(tpl_dir & tplfile)) then
                 Set oFile = FSO.OpenTextFile(Server.Mappath(tpl_dir & tplfile))
                 tpl = oFile.ReadAll
                 oFile.Close
                 Set oFile = Nothing
           Else
                 Response.Write "模板文件不存在！<br>"
           End if
           Set FSO = nothing
     End Sub

'取得区块模板      
'========================

'从变量取出
     Public sub SetBlk(blkname, tplvar)
           re.IgnoreCase = True
           re.Global = True
           re.Pattern = {{ & blkname & }}
           tpl = re.Replace(tpl, tplvar)
           rs.Close
     End Sub

'从数据库取出
     Public sub SetBlkDb(blkname, tplname)
           Dim sql, rs
           Set rs = Server.CreateObject("ADODB.RecordSet")
           sql = "SELECT * FROM templates WHERE name = '"&tplname&"'"
           rs.Open sql,conn,1,1
           tmp = rs("content")
           rs.Close
           SetBlk blkname, tmp
           set rs = Nothing
     End Sub

'从文件取出
     Public sub SetBlkFile(blkname, tplfile)
           Dim FSO, oFile
           Set FSO = createobject("Scripting.FileSystemObject")
           If FSO.FileExists(server.mappath(tpl_dir &tplfile)) Then
                 Set oFile = FSO.OpenTextFile(Server.MapPath(tpl_dir &tplfile))
                 tmp = oFile.ReadAl
                 SetBlock blkname, tmp
                 oFile.Close
                 set oFile = Nothing
           Else
                 Response.Write "区块模板文件不存在！<br>"
           End If
           Set FSO = Nothing
     End Sub
     
'设置变量替换值      
'========================

'简单替换
     Public Sub SetVar(sName, sValue)
           If var_list.Exists(sName) then
                 var_list.Remove sName
                 var_list.Add sName, sValue
           Else
                 var_list.Add sName, sValue
           End if
     End Sub
     
'简单替换 追加数据
     Public Sub AppendVar(sName, sValue)
           If var_list.Exists(sName) then
                 tmp = var_list.Item(sName) & sValue
                 var_list.Remove sName
                 var_list.Add sName, tmp
           Else
                 var_list.Add sName, sValue
           End If
     End Sub

'循环替换      
'========================      
     
'一维循环开始
     Public Sub UdBlk(BlkName)
           tpl_blk = BlkName
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "<!--\s+BEGIN\s+(" & BlkName & ")\s+-->([\s\S.]*)<!--\s+END\s+\1\s+-->"
           Set Matches = re.Execute(tpl)
           If Matches.Count > 0 Then
                 Set match = Matches
                 For Each match In Matches
                       blk_list.Add BlkName, match.SubMatches(1)
                       var_list.Add BlkName, ""
                       tpl = re.Replace(tpl, "{{"&BlkName&"}}")
                 next
           Else
                 Response.Write "Block " & BlkName & " does not exists!"
           End If      
     end sub

'一维循环结束      
     Public Sub PsBlk(BlkName)
           tmp = blk_list.Item(BlkName)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & p_var_tag_o & ")([^}]+)" & p_var_tag_c
           Set Matches = re.Execute(tmp)  
           for each match in Matches
                 if blk_var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.value
                       tmp = re.Replace(tmp, blk_var_list.Item(match.SubMatches(1)))
                 end if
           next
           tmp = var_list.Item(BlkName) & tmp
           var_list.Remove BlkName
           var_list.Add BlkName, tmp

           blk_var_list.RemoveAll
     End Sub
     
'二维循环开始
     Public Sub UdBlk2(BlkName)
           tmp = blk_list.Item(tpl_blk)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "<!--\s+BEGIN\s+(" & BlkName & ")\s+-->([\s\S.]*)<!--\s+END\s+\1\s+-->"
           Set Matches = re.Execute(tmp)
           If Matches.Count > 0 Then
                 Set match = Matches
                 For Each match In Matches
                       blk_list.Add BlkName, match.SubMatches(1)
                       'response.Write match.SubMatches(1)
                       blk_var_list.Add BlkName, ""
                       tmp = re.Replace(tmp, "{{"&BlkName&"}}")
                       blk_list.ReMove tpl_blk
                       blk_list.Add tpl_blk, tmp
                 next
           Else
                 Response.Write "Block " & BlkName & " does not exists!"
           End If      
     end sub      
     
'二维循环结束      
     Public Sub PsBlk2(BlkName)
           tmp = blk_list.Item(BlkName)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & p_var_tag_o & ")([^}]+)" & p_var_tag_c
           Set Matches = re.Execute(tmp)  
           for each match in Matches
                 if blk_var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.value
                       tmp = re.Replace(tmp, blk_var_list.Item(match.SubMatches(1)))
                 end if
           next
           tmp = blk_var_list.Item(BlkName) & tmp
           blk_var_list.RemoveAll
           blk_var_list.Add BlkName, tmp
     End Sub

'循环中的替换
     Public Sub SetBlkVar(s, v)
           If blk_var_list.Exists(s) then
                 blk_var_list.Remove s
                 blk_var_list.Add s, v
           Else
                 blk_var_list.Add s, v
           End if
     End Sub

'解析模板和输出内容      
'========================

'执行解析
'可以通过下面的过程取得网页内容，结合fso可以生成静态页面
     Public Property GetTpl
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & {{ & ")([^}]+)" & }}
           Set Matches = re.Execute(tpl)  
           for each match in Matches
                 if var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.Value
                       tpl = re.Replace(tpl, var_list.Item(match.SubMatches(1)))
                 end if
           next
           GetTpl = tpl
     End Property
     
'输出内容
     Public Sub Parse
           Response.Write tpl
     End Sub
End Class
%><%
'=========================================================
' File: class_template.asp
' Version:1.0
' Date: 2004-5-7
' Script Written by R.H
' Description: ASP Template Class
'=========================================================
' Copyright (C) 2004 Interflower Studios. All rights reserved.
' Web: http://www.interflower.cn
' Need help? Contact: [email protected]
'=========================================================

'=========================================================
'模板中替换的部分用{{%}}表示
'模板中的循环用<!-- BEGIN % -->开始 <!-- END % -->结束 支持一次嵌套


Class Template
     Private tmp
     Private tpl_dir, tpl, tpl_blk
     Private var_list, blk_list, blk_var_list
     Private re, match, matchs
     Private Sub class_Initialize
           sql = ""
           tpl_dir = "templates/"
           tpl = ""
           blk=""
           Set var_list = Server.CreateObject("Scripting.Dictionary")
           Set blk_list = Server.CreateObject("Scripting.Dictionary")
           Set blk_var_list = Server.CreateObject("Scripting.Dictionary")
           Set re = New RegExp  
     End Sub

'取得主体模板      
'========================

'从变量取出
     Public Sub SetTpl(tplvar)
           tpl = tplvar
     End Sub
     
' 从DB中取出，自己修改sql语句
     Public Sub SetTplDb(tplname)
           Dim sql, rs
           Set rs = Server.CreateObject("ADODB.RecordSet")
           sql = "SELECT content FROM templates WHERE name = '"&tplname&"'"
           rs.Open sql,conn,1,1
           If rs.RecordCount <> 1 Then
                 Response.Write("数据库错误！<br>")
                 Response.End()
           End If
           tpl = rs("content")
           rs.Close
           Set rs = Nothing
     End Sub
     
'从文件取出
     Public Sub SetTplFile(tplfile)
           Dim FSO, oFile
           Set FSO = Server.Createobject("Scripting.FileSystemObject")
           If FSO.FileExists(Server.Mappath(tpl_dir & tplfile)) then
                 Set oFile = FSO.OpenTextFile(Server.Mappath(tpl_dir & tplfile))
                 tpl = oFile.ReadAll
                 oFile.Close
                 Set oFile = Nothing
           Else
                 Response.Write "模板文件不存在！<br>"
           End if
           Set FSO = nothing
     End Sub

'取得区块模板      
'========================

'从变量取出
     Public sub SetBlk(blkname, tplvar)
           re.IgnoreCase = True
           re.Global = True
           re.Pattern = {{ & blkname & }}
           tpl = re.Replace(tpl, tplvar)
           rs.Close
     End Sub

'从数据库取出
     Public sub SetBlkDb(blkname, tplname)
           Dim sql, rs
           Set rs = Server.CreateObject("ADODB.RecordSet")
           sql = "SELECT * FROM templates WHERE name = '"&tplname&"'"
           rs.Open sql,conn,1,1
           tmp = rs("content")
           rs.Close
           SetBlk blkname, tmp
           set rs = Nothing
     End Sub

'从文件取出
     Public sub SetBlkFile(blkname, tplfile)
           Dim FSO, oFile
           Set FSO = createobject("Scripting.FileSystemObject")
           If FSO.FileExists(server.mappath(tpl_dir &tplfile)) Then
                 Set oFile = FSO.OpenTextFile(Server.MapPath(tpl_dir &tplfile))
                 tmp = oFile.ReadAl
                 SetBlock blkname, tmp
                 oFile.Close
                 set oFile = Nothing
           Else
                 Response.Write "区块模板文件不存在！<br>"
           End If
           Set FSO = Nothing
     End Sub
     
'设置变量替换值      
'========================

'简单替换
     Public Sub SetVar(sName, sValue)
           If var_list.Exists(sName) then
                 var_list.Remove sName
                 var_list.Add sName, sValue
           Else
                 var_list.Add sName, sValue
           End if
     End Sub
     
'简单替换 追加数据
     Public Sub AppendVar(sName, sValue)
           If var_list.Exists(sName) then
                 tmp = var_list.Item(sName) & sValue
                 var_list.Remove sName
                 var_list.Add sName, tmp
           Else
                 var_list.Add sName, sValue
           End If
     End Sub

'循环替换      
'========================      
     
'一维循环开始
     Public Sub UdBlk(BlkName)
           tpl_blk = BlkName
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "<!--\s+BEGIN\s+(" & BlkName & ")\s+-->([\s\S.]*)<!--\s+END\s+\1\s+-->"
           Set Matches = re.Execute(tpl)
           If Matches.Count > 0 Then
                 Set match = Matches
                 For Each match In Matches
                       blk_list.Add BlkName, match.SubMatches(1)
                       var_list.Add BlkName, ""
                       tpl = re.Replace(tpl, "{{"&BlkName&"}}")
                 next
           Else
                 Response.Write "Block " & BlkName & " does not exists!"
           End If      
     end sub

'一维循环结束      
     Public Sub PsBlk(BlkName)
           tmp = blk_list.Item(BlkName)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & p_var_tag_o & ")([^}]+)" & p_var_tag_c
           Set Matches = re.Execute(tmp)  
           for each match in Matches
                 if blk_var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.value
                       tmp = re.Replace(tmp, blk_var_list.Item(match.SubMatches(1)))
                 end if
           next
           tmp = var_list.Item(BlkName) & tmp
           var_list.Remove BlkName
           var_list.Add BlkName, tmp

           blk_var_list.RemoveAll
     End Sub
     
'二维循环开始
     Public Sub UdBlk2(BlkName)
           tmp = blk_list.Item(tpl_blk)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "<!--\s+BEGIN\s+(" & BlkName & ")\s+-->([\s\S.]*)<!--\s+END\s+\1\s+-->"
           Set Matches = re.Execute(tmp)
           If Matches.Count > 0 Then
                 Set match = Matches
                 For Each match In Matches
                       blk_list.Add BlkName, match.SubMatches(1)
                       'response.Write match.SubMatches(1)
                       blk_var_list.Add BlkName, ""
                       tmp = re.Replace(tmp, "{{"&BlkName&"}}")
                       blk_list.ReMove tpl_blk
                       blk_list.Add tpl_blk, tmp
                 next
           Else
                 Response.Write "Block " & BlkName & " does not exists!"
           End If      
     end sub      
     
'二维循环结束      
     Public Sub PsBlk2(BlkName)
           tmp = blk_list.Item(BlkName)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & p_var_tag_o & ")([^}]+)" & p_var_tag_c
           Set Matches = re.Execute(tmp)  
           for each match in Matches
                 if blk_var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.value
                       tmp = re.Replace(tmp, blk_var_list.Item(match.SubMatches(1)))
                 end if
           next
           tmp = blk_var_list.Item(BlkName) & tmp
           blk_var_list.RemoveAll
           blk_var_list.Add BlkName, tmp
     End Sub

'循环中的替换
     Public Sub SetBlkVar(s, v)
           If blk_var_list.Exists(s) then
                 blk_var_list.Remove s
                 blk_var_list.Add s, v
           Else
                 blk_var_list.Add s, v
           End if
     End Sub

'解析模板和输出内容      
'========================

'执行解析
'可以通过下面的过程取得网页内容，结合fso可以生成静态页面
     Public Property GetTpl
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & {{ & ")([^}]+)" & }}
           Set Matches = re.Execute(tpl)  
           for each match in Matches
                 if var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.Value
                       tpl = re.Replace(tpl, var_list.Item(match.SubMatches(1)))
                 end if
           next
           GetTpl = tpl
     End Property
     
'输出内容
     Public Sub Parse
           Response.Write tpl
     End Sub
End Class
%><%
'=========================================================
' File: class_template.asp
' Version:1.0
' Date: 2004-5-7
' Script Written by R.H
' Description: ASP Template Class
'=========================================================
' Copyright (C) 2004 Interflower Studios. All rights reserved.
' Web: http://www.interflower.cn
' Need help? Contact: [email protected]
'=========================================================

'=========================================================
'模板中替换的部分用{{%}}表示
'模板中的循环用<!-- BEGIN % -->开始 <!-- END % -->结束 支持一次嵌套


Class Template
     Private tmp
     Private tpl_dir, tpl, tpl_blk
     Private var_list, blk_list, blk_var_list
     Private re, match, matchs
     Private Sub class_Initialize
           sql = ""
           tpl_dir = "templates/"
           tpl = ""
           blk=""
           Set var_list = Server.CreateObject("Scripting.Dictionary")
           Set blk_list = Server.CreateObject("Scripting.Dictionary")
           Set blk_var_list = Server.CreateObject("Scripting.Dictionary")
           Set re = New RegExp  
     End Sub

'取得主体模板      
'========================

'从变量取出
     Public Sub SetTpl(tplvar)
           tpl = tplvar
     End Sub
     
' 从DB中取出，自己修改sql语句
     Public Sub SetTplDb(tplname)
           Dim sql, rs
           Set rs = Server.CreateObject("ADODB.RecordSet")
           sql = "SELECT content FROM templates WHERE name = '"&tplname&"'"
           rs.Open sql,conn,1,1
           If rs.RecordCount <> 1 Then
                 Response.Write("数据库错误！<br>")
                 Response.End()
           End If
           tpl = rs("content")
           rs.Close
           Set rs = Nothing
     End Sub
     
'从文件取出
     Public Sub SetTplFile(tplfile)
           Dim FSO, oFile
           Set FSO = Server.Createobject("Scripting.FileSystemObject")
           If FSO.FileExists(Server.Mappath(tpl_dir & tplfile)) then
                 Set oFile = FSO.OpenTextFile(Server.Mappath(tpl_dir & tplfile))
                 tpl = oFile.ReadAll
                 oFile.Close
                 Set oFile = Nothing
           Else
                 Response.Write "模板文件不存在！<br>"
           End if
           Set FSO = nothing
     End Sub

'取得区块模板      
'========================

'从变量取出
     Public sub SetBlk(blkname, tplvar)
           re.IgnoreCase = True
           re.Global = True
           re.Pattern = {{ & blkname & }}
           tpl = re.Replace(tpl, tplvar)
           rs.Close
     End Sub

'从数据库取出
     Public sub SetBlkDb(blkname, tplname)
           Dim sql, rs
           Set rs = Server.CreateObject("ADODB.RecordSet")
           sql = "SELECT * FROM templates WHERE name = '"&tplname&"'"
           rs.Open sql,conn,1,1
           tmp = rs("content")
           rs.Close
           SetBlk blkname, tmp
           set rs = Nothing
     End Sub

'从文件取出
     Public sub SetBlkFile(blkname, tplfile)
           Dim FSO, oFile
           Set FSO = createobject("Scripting.FileSystemObject")
           If FSO.FileExists(server.mappath(tpl_dir &tplfile)) Then
                 Set oFile = FSO.OpenTextFile(Server.MapPath(tpl_dir &tplfile))
                 tmp = oFile.ReadAl
                 SetBlock blkname, tmp
                 oFile.Close
                 set oFile = Nothing
           Else
                 Response.Write "区块模板文件不存在！<br>"
           End If
           Set FSO = Nothing
     End Sub
     
'设置变量替换值      
'========================

'简单替换
     Public Sub SetVar(sName, sValue)
           If var_list.Exists(sName) then
                 var_list.Remove sName
                 var_list.Add sName, sValue
           Else
                 var_list.Add sName, sValue
           End if
     End Sub
     
'简单替换 追加数据
     Public Sub AppendVar(sName, sValue)
           If var_list.Exists(sName) then
                 tmp = var_list.Item(sName) & sValue
                 var_list.Remove sName
                 var_list.Add sName, tmp
           Else
                 var_list.Add sName, sValue
           End If
     End Sub

'循环替换      
'========================      
     
'一维循环开始
     Public Sub UdBlk(BlkName)
           tpl_blk = BlkName
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "<!--\s+BEGIN\s+(" & BlkName & ")\s+-->([\s\S.]*)<!--\s+END\s+\1\s+-->"
           Set Matches = re.Execute(tpl)
           If Matches.Count > 0 Then
                 Set match = Matches
                 For Each match In Matches
                       blk_list.Add BlkName, match.SubMatches(1)
                       var_list.Add BlkName, ""
                       tpl = re.Replace(tpl, "{{"&BlkName&"}}")
                 next
           Else
                 Response.Write "Block " & BlkName & " does not exists!"
           End If      
     end sub

'一维循环结束      
     Public Sub PsBlk(BlkName)
           tmp = blk_list.Item(BlkName)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & p_var_tag_o & ")([^}]+)" & p_var_tag_c
           Set Matches = re.Execute(tmp)  
           for each match in Matches
                 if blk_var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.value
                       tmp = re.Replace(tmp, blk_var_list.Item(match.SubMatches(1)))
                 end if
           next
           tmp = var_list.Item(BlkName) & tmp
           var_list.Remove BlkName
           var_list.Add BlkName, tmp

           blk_var_list.RemoveAll
     End Sub
     
'二维循环开始
     Public Sub UdBlk2(BlkName)
           tmp = blk_list.Item(tpl_blk)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "<!--\s+BEGIN\s+(" & BlkName & ")\s+-->([\s\S.]*)<!--\s+END\s+\1\s+-->"
           Set Matches = re.Execute(tmp)
           If Matches.Count > 0 Then
                 Set match = Matches
                 For Each match In Matches
                       blk_list.Add BlkName, match.SubMatches(1)
                       'response.Write match.SubMatches(1)
                       blk_var_list.Add BlkName, ""
                       tmp = re.Replace(tmp, "{{"&BlkName&"}}")
                       blk_list.ReMove tpl_blk
                       blk_list.Add tpl_blk, tmp
                 next
           Else
                 Response.Write "Block " & BlkName & " does not exists!"
           End If      
     end sub      
     
'二维循环结束      
     Public Sub PsBlk2(BlkName)
           tmp = blk_list.Item(BlkName)
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & p_var_tag_o & ")([^}]+)" & p_var_tag_c
           Set Matches = re.Execute(tmp)  
           for each match in Matches
                 if blk_var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.value
                       tmp = re.Replace(tmp, blk_var_list.Item(match.SubMatches(1)))
                 end if
           next
           tmp = blk_var_list.Item(BlkName) & tmp
           blk_var_list.RemoveAll
           blk_var_list.Add BlkName, tmp
     End Sub

'循环中的替换
     Public Sub SetBlkVar(s, v)
           If blk_var_list.Exists(s) then
                 blk_var_list.Remove s
                 blk_var_list.Add s, v
           Else
                 blk_var_list.Add s, v
           End if
     End Sub

'解析模板和输出内容      
'========================

'执行解析
'可以通过下面的过程取得网页内容，结合fso可以生成静态页面
     Public Property GetTpl
           re.IgnoreCase = True
           re.Global = True

           re.Pattern = "(" & {{ & ")([^}]+)" & }}
           Set Matches = re.Execute(tpl)  
           for each match in Matches
                 if var_list.Exists(match.SubMatches(1)) then
                       re.Pattern = match.Value
                       tpl = re.Replace(tpl, var_list.Item(match.SubMatches(1)))
                 end if
           next
           GetTpl = tpl
     End Property
     
'输出内容
     Public Sub Parse
           Response.Write tpl
     End Sub
End Class
%>

本文地址：http://com.8s8s.com/it/it8964.htm