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

%>

• ·动态禁用/启用Win2000下的Ctrl+Al
• ·Dot Net的调试 - 3
• ·Windows2000 Config
• ·VC中的一些调试技巧
• ·PHP MVC结构演示
• ·注册表一点也不神秘！用VC++修改注册表---
• ·如何Disabled 服务器端Button
• ·解决.net开发问题的最终法宝
• ·深入探讨MFC消息循环和消息泵
• ·递归法