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: ranhuan@msn.com
'=========================================================
'=========================================================
'模板中替换的部分用{{%}}表示
'模板中的循环用<!-- 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: ranhuan@msn.com
'=========================================================
'=========================================================
'模板中替换的部分用{{%}}表示
'模板中的循环用<!-- 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: ranhuan@msn.com
'=========================================================
'=========================================================
'模板中替换的部分用{{%}}表示
'模板中的循环用<!-- 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
%>