<?xml version="1.0" encoding="utf-8"?>
 <dfcms>
 <name>模板名称</name>
 <author>模板的作者</author>
 <info>版权信息及相关说明</info>
 </dfcms>

4.所有文件统一采用UTF-8编码

5.文件功能：
 t.gif     模板缩略图
 t.xml     模板配置相关信息
 content.html   内容HTML页
 footer.html    网上底部HTML代码
 left.html    网站左侧HTMl代码
 newsdetail.html   新闻明细页
 newslist.html   新闻列表页
 outherdetail.html  其它类明细页
 outherlist.html   其它类列表页
 productdetail.html  产品明细页
 productlist.html  产品列表页
 top.html    网站头部HTML代码

6.标签定义
 ------页面类------
 {{pageTop}}    头部页
 {{pageLeft}}   左侧页
 {{pageFooter}}   底部页
 
 ------变量类------
 {{tmpPath}}    模板路径
 {{tmpComTitle}}   单位名称
 {{tmpComAddress}}  单位地址 
 {{tmpComTel}}   单位电话
 {{tmpComFax}}   单位传真
 {{tmpWebTitle}}   网站名称
 {{tmpWebUrl}}   网站地址
 {{tmpWebICP}}   网站ICP备案
 {{tmpWebHits}}   网站点击次数
 {{tmpDescription}}  网站Mate信息
 {{tmpKeywords}}   网站Mate信息
 {{tmpLocation}}   我的当前位置
 
 ------函数类------
 {{funMenu}}    定义一个导航栏
 {{funNewsClass}}  定义一个新闻分类
 {{funProductClass}}  定义一个产品分类
 {{funListPage}}   定义一个分页
 {{funChannelTitle}}  定义一个栏目标题
 {{funChannelContent}} 定义一个栏目内容
 
 {{funListTitle}}  定义一个明细标题
 {{funListPicBig}}  定义一个明细大图
 {{funListContent}}  定义一个明细内容
 {{funListFile}}   定义一个明细附件
 {{funListHits}}   定义一个明细点击数
 {{funListAddTime}}  定义一个明细添加时间
 {{funListAddUser}}  定义一个明细添加人员
 {{funListExt}}   定义一组附加属性

其它的脚本语言，如JSP、PHP都有自己的解决方案，ASP的后一代产品ASP.NET也实现了代码与页面，似乎直接过渡到ASP是不错的选择。但是总有这样或那样的原因让我们不能或暂时不能放弃ASP直奔.NET大营。从公司角度来看，转换语言是一笔不少的投资，包括雇佣熟手.NET程序员、培训原有程序员、开发工具的转型、开发风格的转型、界面风格转变、接口风格、软件架构、文档、开发流程等等；这还意味着原有的代码必须在新语言环境里重写以实现最佳的效果和稳定性；同时将直接影响这段时间内项目的进度，更有可能导致个别程序员出走。由此看来在您决定转换语言之前，在原基础上寻求一种解决方案，才是最好的选择。

PHP通过模板实现代码与页面，可供选择的有FastTemplate、PHPLIB、Smarty等多种，其中PHPLIB的影响最大、使用最多。既然如此，我们直接把它搬到ASP来，对于同时使用PHP和ASP的公司还有很有好处：一、美工处理页面时，不管将要套用PHP还是ASP，处理方式是一样，无须经过培训；二、程序员编写代码时，两种语言间的思路接近或一致，相同功能在两种语言实现时，只需拷贝过来略作修改即可，保证了工作效率和项目进度。

1、模板类的设计

实现代码封装成为模板类，即是为了与PHPLIB兼容，也使得代码方便管理与扩展。
模板类要实现的目标为：从模板文件中读入显示的HTML代码，将这些显示代码中需要动态数据的地方替换为ASP程序运算所得出的数据，然后按照一定的顺序输出。其中，替换的部分可以自由的设定。因此它必须完成如下任务：

     ·从模板文件中读取显示用的HTML代码。
     ·将模板文件和实际生成的数据结合，生成输出的结果。
     ·允许同时处理多个模板。
     ·允许模板的嵌套。
     ·允许对模板中的某个单独的部分进行处理。

实现方法：

采用FSO读取模板文件
采用正则替换实现模板文件和数据的结合
处理多个模板用数组存储来实现。

模板的嵌套的实现主要的想法是：将模板和输出（任何中间的分析结果）一视同仁，都可拿来做替换，即可实现。

单独部分的处理的通过在模板文件中设定标注，然后在正则替换中结合标注来控制，实现部分替换。

2、模板类的实现

给出具体代码之前，先把主要函数列出，用过PHPLIB的朋友应该对此很熟悉了：

1）Public Sub set_root(ByVal Value)　设定模板默认目录 2）Public Sub set_file(ByVal handle,ByVal   filename)　读取文件 3）Public Sub set_var(ByVal Name, ByVal Value, ByVal Append)　设置映射数据-替换变量 4）Public Sub unset_var(ByVal Name)　取消数据映射 5）Public Sub set_block(ByVal Parent, ByVal BlockTag, ByVal Name)　设置数据块 6）Public Sub set_unknowns(ByVal unknowns)　设定未指定映射的标记处理方式 7）Public Sub parse(ByVal Name, ByVal BlockTag, ByVal Append)　执行模板文件与数据的结合 8）Public Sub p(ByVal Name)　输出处理结果

实现代码：

<% '================================================================ ' CLASS NAME:   kktTemplate ASP页面模板对象 ' DESIGN BY :      彭国辉 ' DATE:                  2004-07-05 ' WEBSITE:           http://kacarton.yeah.net/ ' BLOG:                 http://blog.csdn.net/nhconch ' EMAIL:               kacarton@sohu.com ' ' 本对象中使用了set_var、set_block等命名方法是为了兼容phplib '文章为作者原创，转载前请先与本人联系，转载请注明文章出处、保留作者信息，谢谢支持！ '================================================================ Class kktTemplate          Private m_FileName, m_Root, m_Unknowns, m_LastError, m_HaltOnErr      Private m_ValueList, m_BlockList      Private m_RegExp         ' 构造函数      Private Sub Class_Initialize          Set m_ValueList      = CreateObject("Scripting.Dictionary")          Set m_BlockList      = CreateObject("Scripting.Dictionary")          set m_RegExp         = New RegExp          m_RegExp.IgnoreCase = True          m_RegExp.Global      = True          m_FileName           = ""          m_Root               = ""          m_Unknowns           = "remove"          m_LastError          = ""          m_HaltOnErr          = true      End Sub          ' 析构函数      Private Sub Class_Terminate          Set m_RegExp        = Nothing          Set m_BlockMatches = Nothing          Set m_ValueMatches = nothing      End Sub          Public Property Get ClassName()          ClassName = "kktTemplate"      End Property          Public Property Get Version()          Version = "1.0"      End Property          Public Sub About()          Response.Write("kktTemplate ASP页面模板类<br>" & vbCrLf &_                         "程序设计：彭国辉 2004-07-05<br>" & vbCrLf &_                         "个人网站：<a href='http://kacarton.yeah.net'>http://kacarton.yeah.net</a><br>" & vbCrLf &_                         "电子邮件：<a href='mailto:kacarton@sohu.com'>kacarton@sohu.com</a><br>")      End Sub          '检查目录是否存在      Public Function FolderExist(ByVal path)          Dim fso          Set fso = CreateObject("Scripting.FileSystemObject")          FolderExist = fso.FolderExists(Server.MapPath(path))          Set fso = Nothing      End Function      '读取文件内容      Private Function LoadFile()          Dim Filename, fso, hndFile          Filename = m_Root          If Right(Filename, 1)<>"/" And Right(Filename, 1)<>"\" Then Filename = Filename & "/"          Filename = Server.MapPath(Filename & m_FileName)          Set fso = CreateObject("Scripting.FileSystemObject")          If Not fso.FileExists(Filename) Then ShowError("模板文件" & m_FileName & "不存在!")          set hndFile = fso.OpenTextFile(Filename)          LoadFile = hndFile.ReadAll          Set hndFile = Nothing          Set fso = Nothing          If LoadFile = "" Then ShowError("不能读取模板文件" & m_FileName & "或文件为空!")      End Function          '处理错误信息      Private Sub ShowError(ByVal msg)          m_LastError = msg          Response.Write "<font color=red style='font-size;14px'><b>模板错误：" & msg & "</b></font><br>"          If m_HaltOnErr Then Response.End      End Sub          '设置模板文件默认目录      'Ex: kktTemplate.set_root("/tmplate")      '     kktTemplate.Root = "/tmplate"      '     root = kktTemplate.get_root()      '     root = kktTemplate.Root      '使用类似set_root这样的命名方法是为了兼容phplib，以下将不再重复说明      Public Sub set_root(ByVal Value)          If Not FolderExist(Value) Then ShowError(Value & "不是有效目录或目录不存在!")          m_Root = Value      End Sub      Public Function get_root()          get_root = m_Root      End Function      Public Property Let Root(ByVal Value)          set_root(Value)      End Property      Public Property Get Root()          Root = m_Root      End Property          '设置模板文件      'Ex: kktTemplate.set_file("hndTpl", "index.htm")      '本类不支持多模板文件，handle为兼容phplib而保留      Public Sub set_file(ByVal handle,ByVal   filename)          m_FileName = filename          m_BlockList.Add Handle, LoadFile()      End Sub      Public Function get_file()          get_file = m_FileName      End Function '      Public Property Let File(handle, filename) '          set_file handle, filename '      End Property '      Public Property Get File() '          File = m_FileName '      End Property          '设置对未指定的标记的处理方式，有keep、remove、comment三种      Public Sub set_unknowns(ByVal unknowns)          m_Unknowns = unknowns      End Sub      Public Function get_unknowns()          get_unknowns = m_Unknowns      End Function      Public Property Let Unknowns(ByVal unknown)          m_Unknowns = unknown      End Property      Public Property Get Unknowns()          Unknowns = m_Unknowns      End Property          Public Sub set_block(ByVal Parent, ByVal BlockTag, ByVal Name)          Dim Matches          m_RegExp.Pattern = "<!--\s+BEGIN " & BlockTag & "\s+-->([\s\S.]*)<!--\s+END " & BlockTag & "\s+-->"          If Not m_BlockList.Exists(Parent) Then ShowError("未指定的块标记" & Parent)          set Matches = m_RegExp.Execute(m_BlockList.Item(Parent))          For Each Match In Matches              m_BlockList.Add BlockTag, Match.SubMatches(0)              m_BlockList.Item(Parent) = Replace(m_BlockList.Item(Parent), Match.Value, "{" & Name & "}")          Next          set Matches = nothing      End Sub          Public Sub set_var(ByVal Name, ByVal Value, ByVal Append)          Dim Val          If IsNull(Value) Then Val = "" Else Val = Value          If m_ValueList.Exists(Name) Then              If Append Then m_ValueList.Item(Name) = m_ValueList.Item(Name) & Val _              Else m_ValueList.Item(Name) = Val          Else              m_ValueList.Add Name, Value          End If      End Sub          Public Sub unset_var(ByVal Name)          If m_ValueList.Exists(Name) Then m_ValueList.Remove(Name)      End Sub          Private Function InstanceValue(ByVal BlockTag)          Dim keys, i          InstanceValue = m_BlockList.Item(BlockTag)          keys = m_ValueList.Keys          For i=0 To m_ValueList.Count-1              InstanceValue = Replace(InstanceValue, "{" & keys(i) & "}", m_ValueList.Item(keys(i)))          Next      End Function          Public Sub parse(ByVal Name, ByVal BlockTag, ByVal Append)          If Not m_BlockList.Exists(BlockTag) Then ShowError("未指定的 块标记" & Parent)          If m_ValueList.Exists(Name) Then              If Append Then m_ValueList.Item(Name) = m_ValueList.Item(Name) & InstanceValue(BlockTag) _              Else m_ValueList.Item(Name) = InstanceValue(BlockTag)          Else              m_ValueList.Add Name, InstanceValue(BlockTag)          End If      End Sub          Private Function finish(ByVal content)          Select Case m_Unknowns              Case "keep" finish = content              Case "remove"                  m_RegExp.Pattern = "\{[^ \t\r\n}]+\}"                  finish = m_RegExp.Replace(content, "")              Case "comment"                  m_RegExp.Pattern = "\{([^ \t\r\n}]+)\}"                  finish = m_RegExp.Replace(content, "<!-- Template Variable $1 undefined -->")              Case Else finish = content          End Select      End Function          Public Sub p(ByVal Name)          If Not m_ValueList.Exists(Name) Then ShowError("不存在的标记" & Name)          Response.Write(finish(m_ValueList.Item(Name)))      End Sub End Class %>

3、使用例子

下面举三个例子进行说明。

1)简单的值替换

模板文件为myTemple.tpl，内容：

<html><title>ASP模板简单替换</title><body> 祝贺！你赢了一辆{some_color}法拉利！ </body>

下面是ASP代码（kktTemplate.inc.asp就是上面给出的模板类）：

<!--#INCLUDE file="kktTemplate.inc.asp"--> <% dim my_color, kkt my_color = "红色的" set kkt = new kktTemplate                  '创建模板对象 kkt.set_file "hndKktTemp", "myTemple.tpl" '设置并读取模板文件myTemple.tpl kkt.set_var "some_color", my_color, false '设置模板变量 some_color = my_color的值 kkt.parse "out", "hndKktTemp", false       '模板变量 out = 处理后的文件 kkt.p "out"                                '输出out的内容 set kkt = nothing                          '销毁模板对象 %>

执行后输出为：

<html><title>ASP模板简单替换</title><body> 祝贺！你赢了一辆红色的法拉利！ </body>

2)循环块演示例子

模板文件myTemple2.tpl：

<html><title>ASP模板－块的演示</title><body> <table cellspacing="2" border="1"><tr><td>下面的动物您喜欢哪一种</td></tr> <!-- BEGIN AnimalList --> <tr><td><input type="radio" name="chk">{animal}</td></tr> <!-- END AnimalList --> </table> </body>

ASP代码：

<!--#INCLUDE file="kktTemplate.inc.asp"--> <% dim animal, kkt, i animal = Array("小猪","小狗","小强") set kkt = new kktTemplate kkt.set_file "hndKktTemp", "myTemple2.tpl" kkt.set_block "hndKktTemp", "AnimalList", "list" for i=0 to UBound(animal)      kkt.set_var "animal", animal(i), false      kkt.parse "list", "AnimalList", true next kkt.parse "out", "hndKktTemp", false kkt.p "out" set kkt = nothing %>

执行结果：

<html><title>ASP模板－块的演示</title><body> <table cellspacing="2" border="1"><tr><td>下面的动物您喜欢哪一种</td></tr> <tr><td><input type="radio" name="chk">小猪</td></tr> <tr><td><input type="radio" name="chk">小狗</td></tr> <tr><td><input type="radio" name="chk">小强</td></tr> </table> </body>

3)嵌套块演示

模板文件myTemple3.tpl：

<html><title>ASP模板－嵌套块演示</title> <body><table width="400" border="1" bordercolor="#000000">    <tr><td><div align="center">{myname}测试</div></td></tr>    <tr><td>我的动植物园：</td> </tr> <!-- BEGIN animalList -->    <tr><td>{animal}</td></tr>    <!-- BEGIN plantList -->      <tr><td>&nbsp;&nbsp;{plant}</td></tr>    <!-- END plantList --> <!-- END animalList --> </table> </body> </html>

ASP代码：

<!--#INCLUDE file="kktTemplate.inc.asp"--> <% dim my_color, kkt, myname, animal, plant set kkt = new kktTemplate myname = "kktTemplate block test..." animal = array("动物", "植物") plant   = array(array("小猪","小白","小强"), array("玫瑰","向日葵")) kkt.set_file "hndKktTemp", "myTemple3.tpl" kkt.set_var "myname", myname, false kkt.set_block "hndKktTemp", "animalList", "a" kkt.set_block "animalList", "plantList", "p" for i=0 to UBound(animal)     kkt.set_var "animal", animal(i), False     kkt.unset_var "p"     'kkt.set_var "p", "", false     for j=0 to UBound(plant(i))          kkt.set_var "plant", plant(i)(j), false          kkt.parse "p", "plantList", true     next     kkt.parse "a", "animalList", true next kkt.parse "out", "hndKktTemp", false kkt.p "out" %>

执行结果：

<html><title>ASP模板－嵌套块演示</title> <body><table width="400" border="1" bordercolor="#000000">    <tr><td><div align="center">kktTemplate block test...测试</div></td></tr>    <tr><td>我的动植物园：</td> </tr>    <tr><td>动物</td></tr>      <tr><td>&nbsp;&nbsp;小猪</td></tr>      <tr><td>&nbsp;&nbsp;小白</td></tr>      <tr><td>&nbsp;&nbsp;小强</td></tr>    <tr><td>植物</td></tr>      <tr><td>&nbsp;&nbsp;玫瑰</td></tr>      <tr><td>&nbsp;&nbsp;向日葵</td></tr> </table> </body> </html>

4、小结

本文主要介绍了基于ASP利用模板类实现代码与页面分离的方法，当然还有其它更好的解决方案。本文旨在抛砖引玉各位读者、WEB开发参与进来，多提宝贵意见，多作交流，共同进步！

Class Cls_Template

Dim Reg
Dim Page
Dim CID
Dim SID
Dim Rule
Dim Content
Dim Template
Dim Cachetimei

Private Sub Class_Initialize()
Set Reg = New RegExp
Reg.Ignorecase = True
Reg.Global = True
Page = 0
CID = 0
SID = 0
Rule = ""
Content = ""
Template = "" ' 模板路径
Cachetimei = -1 ' 标签缓存时间
End Sub

Private Sub Class_Terminate()
'Set Reg = Nothing
End Sub

' 载入模板
Public Function Load(ByVal Templatefile)
Template = Templatefile
If Templatecache = 1 Then
   If ChkCache("LoadTemplate_" & Server.Mappath(Template)) Then
    Content = GetCache("LoadTemplate_" & Server.Mappath(Template))
   Else
    Call Loadfile
    Call SetCache("LoadTemplate_" & Server.Mappath(Template), Content)
   End If
Else
   Call Loadfile
End If
End Function

' 检测SQL缓存
Function ChkCacheSQL(ByVal CacheName)
If Cachetimei <= 0 Then ChkCacheSQL = False: Exit Function
Dim CacheData
ChkCacheSQL = False
CacheName = LCase(Filterstr(CacheName))
CacheData = Application(Cacheflag & CacheName)
If Not IsArray(CacheData) Then Exit Function
If Not IsDate(CacheData(1)) Then Exit Function
If DateDiff("s", CDate(CacheData(1)), Now()) < 60 * Cachetime Then ChkCacheSQL = True
End Function

' 标签分析,有缓存有效期判断
Public Function Parser()
If Not IsNumeric(Page) Then Page = 0 Else Page = Int(Page)
Parser_My ' 自定义标签
Parser_Sys ' 系统标签
Parser_Com ' 列表标签
Parser_IF ' IF ELSE END
End Function

' 自定义标签
Public Function Parser_My()
On Error Resume Next
If GetCache("MyLableState") = "No" Then Content = RegReplace(Content, "{My:([\s\S]*?)}", ""): Exit Function
If Not ChkCache("MyLable") Then
   Dim Rs
   Set Rs = DB("Select [Name],[Code] From [{pre}Label]", 1)
   If Not Rs.Eof Then
    Call SetCache("MyLable", Rs.Getrows())
    Call SetCache("MyLableState", "Yes")
    Rs.Close: Set Rs = Nothing
   Else
    Rs.Close: Set Rs = Nothing
    Call SetCache("MyLableState", "No")
    Content = RegReplace(Content, "{My:([\s\S]*?)}", ""): Exit Function
   End If
End If
Dim Ns, i, j
Ns = GetCache("MyLable")
Dim Matches, Match, MyValue
Reg.Pattern = "{My:([\s\S]*?)}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
   If Len(Replace(Match.SubMatches(0), " ", "")) > 0 Then
    MyValue = Lang_Parser_My_1 & " <font color=red>" & Replace(Match.SubMatches(0), " ", "") & "</font> " & Lang_Parser_My_2
    For i = 0 To UBound(Ns, 2)
     If LCase(Ns(0, i)) = LCase(Replace(Match.SubMatches(0), " ", "")) Then
      MyValue = Ns(1, i)
      If InStr(MyValue, "＄＄＄") > 0 Then
       Randomize
       j = Round(UBound(Split(MyValue, "＄＄＄")) * Rnd) '随机值第一个到最后一个
       MyValue = Split(MyValue, "＄＄＄")(j)
      End If
      Exit For
     End If
    Next
   End If
   Content = Replace(Content, Match.Value, MyValue) ' 替换
   If Err Then Err.Clear: Response.Write "<font color=red>" & Lang_Parser_My_Error & "[" & AspArr(i) & "]</font>": Response.End
Next
End Function

' 分析系统标签
Public Function Parser_Sys()
On Error Resume Next
Dim Matches, Match, SysValue
Reg.Pattern = "{Sys:([\s\S]*?)}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
   If InStr(LCase(Match.SubMatches(0)), "database") = 0 Then
    If Len(Replace(Match.SubMatches(0), " ", "")) > 0 Then Execute ("SysValue = " & Replace(Match.SubMatches(0), " ", "")) Else SysValue = ""
   Else
    SysValue = ""
   End If
   Content = Replace(Content, Match.Value, SysValue) ' 替换
   If Err Then Err.Clear: Response.Write "<font color=red>" & Lang_Parser_Sys_Error & "[" & AspArr(i) & "]</font>": Response.End
Next
reg.pattern = "<(.*?)(src=|href=|value=)""(images/|css/|js/)(.*?)""(.*?)>"
content = reg.replace(content, "<$1$2""" & httpurl & installdir & templatedir & "/$3$4""$5>")
reg.pattern = "{tag:goto}"
content = reg.replace(content, httpurl & installdir & "redirect.asp?")
End Function

' 列表标签
'<!--commend:{ $row=10 $cid={field:cid} $mode=commend }-->..............................<!--commend-->
Public Function Parser_Com()
On Error Resume Next
Dim Matches, Match
Dim Rs, i, j
Dim Matche, BackValue
Dim TagLabs, Tagsstr, Loopstr
Dim Tag_Cache, Tag_Row, Tag_Col, Tag_Width, Tag_Class
Dim Tag_Aid, Tag_Cid, Tag_Type, Tag_Mode, Tag_Keys, Tag_Order
Dim Tag_SQL, Tag_Table, Tag_Where, Tag_Field
Reg.Pattern = "<!--(.+?):\{(.+?)\}-->([\s\S]*?)<!--\1-->"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
   TagLabs = Match.SubMatches(0)   ' 标签
   Tagsstr = Match.SubMatches(1)   ' 属性
   Loopstr = Match.SubMatches(2)   ' innerText
  
   If LCase(TagLabs) <> "page" Then ' 分页标签
    ' 共用属性
    Tag_Cache = GetAttr(Tagsstr, "cache", True) ' 缓存时间 def:defcachetime
    Tag_Row = GetAttr(Tagsstr, "row", True) ' 列数量 def:10
    Tag_Col = GetAttr(Tagsstr, "col", True) ' 行数量 def:1
    Tag_Width = GetAttr(Tagsstr, "width", True) '#表格宽度
    Tag_Class = GetAttr(Tagsstr, "class", False) '#表格样式
    Tag_Field = GetAttr(Tagsstr, "field", True) ' 所有字段
    If Len(Tag_Cache) = 0 Or Not IsNumeric(Tag_Cache) Then Tag_Cache = -1 ' 标签不用缓存
    If Len(Tag_Row) = 0 Or Not IsNumeric(Tag_Row) Then Tag_Row = 10
    If Int(Tag_Row) < 1 Then Tag_Row = 1
    If Len(Tag_Col) = 0 Or Not IsNumeric(Tag_Col) Then Tag_Col = 1
    If Int(Tag_Col) < 1 Then Tag_Col = 1
    If Len(Tag_Width) = 0 Then Tag_Width = "100%"
    If Len(Tag_Class) > 0 Then Tag_Class = " Class=""" & Tag_Class & """ "
    If Len(Tag_Field) = 0 Then Tag_Field = "*"
    Tag_Cache = Int(Tag_Cache): Tag_Row = Int(Tag_Row): Tag_Col = Int(Tag_Col)
    ' 内容Content专用属性
    Tag_Aid = GetAttr(Tagsstr, "aid", True) ' 这个文章不显示出来
    Tag_Cid = GetAttr(Tagsstr, "cid", True) ' 栏目ID,多用个,号分隔
    Tag_Type = GetAttr(Tagsstr, "type", True)   ' 类型: text/images def:text
    Tag_Mode = GetAttr(Tagsstr, "mode", True)   ' 类型(推荐,热门,相关)
    Tag_Keys = GetAttr(Tagsstr, "keys", True)   ' 关键字
    Tag_Order = GetAttr(Tagsstr, "order", False) ' 排序 def:[id] desc[组合查询可用]
    Tag_SQL = GetAttr(Tagsstr, "sql", False) ' 单独SQL查询
    Tag_Table = GetAttr(Tagsstr, "table", True) ' 组合查询,表
    Tag_Where = GetAttr(Tagsstr, "where", False) ' 组合查询,条件
   
    ' 默认设置
    If LCase(Tag_Table) = "channel" And Len(Tag_Where) = 0 Then Tag_Where = "[FatherID]=0 And [OutSideLink]=0 And [Order]>=0"
    If LCase(Tag_Table) = "channel" And Len(Tag_Order) = 0 Then Tag_Order = "[Order] Desc,[ID] Desc"
     
    ' SQL查询组合
    If Len(Tag_SQL) = 0 Then
     If Len(Tag_Table) > 0 Then
      If Len(Tag_Where) > 0 Then Tag_Where = " Where " & Tag_Where & " "
      If Len(Tag_Order) = 0 Then
       If LCase(Tag_Table) = "channel" Then
        Tag_Order = "[Order] Desc,[ID] Desc"
       Else
        Tag_Order = "[ID] Desc"
       End If
      End If
      Tag_SQL = "Select Top " & Tag_Row * Tag_Col & " " & Tag_Field & " From [{pre}" & Tag_Table & "] " & Tag_Where & " Order By " & Tag_Order ' 最终查询语句
     Else
      Tag_Where = ""
      If Len(Tag_Aid) > 0 Then
       If InStr(Tag_Aid, ",") > 0 Then
        Tag_Where = " [ID] In (" & Tag_Aid & ") "
       Else
        Tag_Where = " [ID]<>" & Tag_Aid & " "
       End If
      End If
      If Len(Tag_Cid) > 0 Then
       If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Cid] In (" & Tag_Cid & ") " Else Tag_Where = " [Cid] In (" & Tag_Cid & ") "
       'If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And ([Cid] In (" & Tag_Cid & ") or [Sid] in (" & tag_cid & ")) " Else Tag_Where = " ([Cid] In (" & Tag_Cid & ") or [Sid] in (" & tag_cid & ")) "
      End If
      If LCase(Tag_Type) = "images" Then
       If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Indexpic]<>'' " Else Tag_Where = Tag_Where & " [Indexpic]<>'' "
      End If
      If LCase(Tag_Type) = "noimages" Then
       If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Indexpic]='' " Else Tag_Where = Tag_Where & " [Indexpic]='' "
      End If
      Select Case LCase(Tag_Mode)
      Case "commend"
       If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Commend]=1 " Else Tag_Where = Tag_Where & " [Commend]=1 "
      Case "uncommend"
       If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Commend]=0 " Else Tag_Where = Tag_Where & " [Commend]=0 "
      Case "about"
       If Len(Tag_Keys) > 0 Then
        Tag_Cache = -1 ' 不缓存
        Dim Tag_KeysLink
        Tag_Keys = Split(Replace(Tag_Keys, "'", ""), ",")
        j = UBound(Tag_Keys): If j > 5 Then j = 5
        For i = 0 To j
         If Len(Tag_Keys(i)) > 0 Then
          If Len(Tag_KeysLink) = 0 Then
           Tag_KeysLink = " [Keywords] Like '%" & Tag_Keys(i) & "%'"
          Else
           Tag_KeysLink = Tag_KeysLink & " Or [Keywords] Like '%" & Tag_Keys(i) & "%'"
          End If
         End If
        Next
        If Len(Tag_KeysLink) > 0 Then
         If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And (" & Tag_KeysLink & ") " Else Tag_Where = Tag_Where & " (" & Tag_KeysLink & ") "
        End If
       End If
      End Select
      If LCase(Tag_Mode) = "hot" Then
       Tag_Order = "[Views] Desc"
      Else
       If Len(Tag_Order) = 0 Then Tag_Order = "[ID] Desc"
      End If
      If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Display]=1 " Else Tag_Where = " [Display]=1"
      Tag_SQL = "Select Top " & Tag_Row * Tag_Col & " " & Tag_Field & " From [{pre}Content] Where " & Tag_Where & " Order By " & Tag_Order ' 最终查询语句
     End If
    End If
    Cachetimei = Tag_Cache ' 标签缓存
    If ChkCacheSQL(Template & Tag_SQL) Then
     BackValue = GetCache(Template & Tag_SQL)
    Else
     BackValue = ""
     Err.Clear
     Set Rs = DB(Tag_SQL, 3)
     If Err Then Response.Write "<font color=red>" & Lang_Parser_Com_Error & "[" & Tag_SQL & " => & " & Err.Description & "]</font>": Response.End
     If Tag_Col > 1 Then BackValue = BackValue & "<table width=""" & Tag_Width & """ " & Tag_Class & " border=""0"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf: j = 0 ' 表
     Session(Cacheflag & "_Parser_i") = 0
     For i = 1 To Tag_Row * Tag_Col
      If Rs.Eof Then Exit For ' 不存在记录就退出
      j = j + 1
      If Tag_Col > 1 Then ' 表
       If j = 1 Then BackValue = BackValue & " <tr>" & vbCrLf
       BackValue = BackValue & " <td valign=""top"" width=""" & Round(100 / Tag_Col) & "%"">"
      End If
      If Len(TagLabs) = 0 Then TagLabs = "field"
      Session(Cacheflag & "_Parser_i") = Session(Cacheflag & "_Parser_i") + 1 ' 记数
      BackValue = BackValue & Parser_Tags("\[" & TagLabs & ":(.+?)\]", Loopstr, Rs) ' 替换
      If Tag_Col > 1 Then ' 表
       BackValue = BackValue & " </td>" & vbCrLf
       If j = Tag_Col Then BackValue = BackValue & " </tr>" & vbCrLf: j = 0
      End If
      Rs.MoveNext
     Next
     If Tag_Col > 1 Then
      If j < Tag_Col And j > 0 Then
       For i = 1 To Tag_Col - j
        BackValue = BackValue & " <td></td>" & vbCrLf
       Next
       BackValue = BackValue & " </tr>" & vbCrLf
      End If
      BackValue = BackValue & "</table>" & vbCrLf
     End If
     Rs.Close
     Call SetCache(Template & Tag_SQL, BackValue)
    End If
    Content = Replace(Content, Match.Value, BackValue)
   End If
Next
If RegExists("<!--(.+?):\{(.+?)\}-->([\s\S]*?)<!--\1-->", Content) Then Call Parser_Com ' 多次调用
End Function

' 分页标签
Public Function Parser_Page()
'On Error Resume Next
Dim Matches, Match
Dim Rs, i, j
Dim Matche, BackValue
Dim Tagsstr, Loopstr
Dim Tag_Size, Tag_Order, Tag_Field, Tag_Table, Tag_Style, Tag_SQL, Tag_Where
Dim Tag_RecordCount, Tag_PageCount
Reg.Pattern = "<!--Page:\{(.+?)\}-->([\s\S]*?)<!--Page-->"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
   BackValue = ""
   Tagsstr = Match.SubMatches(0)   ' 属性
   Loopstr = Match.SubMatches(1)   ' innerText
   Tag_Size = GetAttr(Tagsstr, "size", True)
   Tag_Order = GetAttr(Tagsstr, "order", False)
   Tag_Table = GetAttr(Tagsstr, "table", True)
   Tag_Style = GetAttr(Tagsstr, "style", True)
   Tag_Field = GetAttr(Tagsstr, "field", True) ' 所有字段
   If Len(Tag_Size) = 0 Or Not IsNumeric(Tag_Size) Then Tag_Size = 10
   If Len(Tag_Order) = 0 Then Tag_Order = "[ID] Desc"
   If Len(Tag_Table) = 0 Then Tag_Table = "Content"
   If Len(Tag_Style) = 0 Or Not IsNumeric(Tag_Style) Then Tag_Style = 1
   If Len(Tag_Field) = 0 Then Tag_Field = "*"
   Tag_Size = Int(Tag_Size): Tag_Table = " [{pre}" & Tag_Table & "] ": Tag_Style = Int(Tag_Style): Tag_Where = " [Display]=1 "

   If Len(CID) > 0 And isnumeric(CID) Then Tag_Where = Tag_Where & " And [CID]=" & CID ' 存在CID则调用指定CID/SID的内容
   'If Len(CID) > 0 And isnumeric(CID) Then Tag_Where = Tag_Where & " And ([CID]=" & CID & " Or [SID]=" & CID & ")" ' 存在CID则调用指定CID/SID的内容
   If Len(CID) = 0 And Len(SID)>0 And isnumeric(SID) Then Tag_Where = Tag_Where & " And [SID]=" & SID ' 不存在CID,而存在SID则调用SID的内容

   Set Rs = New DataList
   Rs.Result = 1
   Rs.Field = Tag_Field
   Rs.Table = Tag_Table
   Rs.Where = Tag_Where
   Rs.Order = Tag_Order
   Rs.PageSize = Tag_Size
   Rs.AbsolutePage = Page
   Rs.List()
   Session(Cacheflag & "_Parser_i") = 0
   For i = 1 To Tag_Size
    If Rs.Data.Eof Then Exit For
    Session(Cacheflag & "_Parser_i") = Session(Cacheflag & "_Parser_i") + 1 ' 记数
    BackValue = BackValue & Parser_Tags("\[Page:(.+?)\]", Loopstr, Rs.Data) ' 替换
    Rs.Data.MoveNext
   Next
   Content = RegReplace(Content, "{tag:page}", "{{tag:page_www.5u.hk}}")
   Content = Replace(Content, Match.Value, BackValue)
   Tag_RecordCount = Rs.RecordCount: Tag_PageCount = Rs.PageCount: Rs.Data.Close
   If Tag_PageCount = 0 Then Tag_PageCount = 1
Next
Dim GetPageList
if matches.count >0 then
   GetPageList = PageListX(Tag_PageCount, Tag_RecordCount, Page, Tag_Size, CID)
end if
Content = RegReplace(Content, "{{tag:page_www.5u.hk}}", GetPageList)
Set Rs = Nothing
End Function

' 字符替换
Public Function Parser_Tags(ByVal Pattern, ByVal Temp, ByVal Dat)
On Error Resume Next
Dim Matches, Match
Dim Tagsstr, Tagsval, Tagsvalt, TagTitle: TagTitle = False
Dim Tag_Len, Tag_Lenext, Tag_Format, Tag_Replace, Tag_Function,Tag_width,Tag_Height
Dim Re, Re1, Re2
Dim i, c, l, t
Reg.Pattern = Pattern
Set Matches = Reg.Execute(Temp)
For Each Match In Matches
   Tagsstr = Match.SubMatches(0)
   Tag_Len = GetAttr(Tagsstr, "len", True)
   Tag_Lenext = GetAttr(Tagsstr, "lenext", True)
   Tag_Format = GetAttr(Tagsstr, "format", False)
   Tag_Replace = GetAttr(Tagsstr, "replace", False)
   Tag_Function = GetAttr(Tagsstr, "function", True)
   Tag_Width=GetAttr(Tagsstr, "width", True)
   Tag_Height=GetAttr(Tagsstr, "height", True)
   Tagsval = Split(Tagsstr, " ")(0)
   Select Case LCase(Tagsval)
   Case "aid"
    Tagsval = Dat("AID")
    If Err Then Err.Clear: Tagsval = Dat("ID")    ' Content
   Case "aurl"
    Tagsval = Dat("ID") ' Content
    Tagsval = BuildViewPath(Dat("ID"), Dat("Cid"), Dat("Diyname"), Dat("Createtime"), Dat("ViewPath"))
   Case "curl"
    Tagsval = Dat("Cid") ' Content
    If Err Then Err.Clear: Tagsval = Dat("ID") ' Channel
    If Createhtml = 1 Then ' 栏目只在1时才会生成,其他均不生成
     If Len(GetChannel(Tagsval, "Domain")) > 0 Then Tagsval = GetChannel(Tagsval, "Domain") Else Tagsval = Httpurl & GetChannel(Tagsval, "Ruleindex")
    Else ' ASP
     If Len(GetChannel(Tagsval, "Domain")) > 0 Then Tagsval = GetChannel(Tagsval, "Domain") Else Tagsval = Httpurl & Installdir & "channel.asp?id=" & Tagsval
    End If
   Case "surl" ' sid -> name
    Tagsval = ""
   Case "cname"
    Tagsval = GetChannel(Dat("cid"), "name")
   Case "sname" ' sid -> name
    Tagsval = ""
   Case "ctable"
    Tagsval = GetChannel(Dat("cid"), "table")
   Case "titlex"
    Tagsval = Dat("Title") ' Content
    TagTitle = True
   Case "modeindex"
    Tagsval = ""
   Case "i"
    Tagsval = Session(Cacheflag & "_Parser_i")
   Case Else
    If LCase(Left(Tagsval, 5)) = "mode_" Then
     Dim Modetag: Modetag = Right(Tagsval, Len(Tagsval) - 5)
     Tagsval = Dat("ModeIndex")
     If Len(Tagsval) > 0 And InStr(Tagsval, "<" & Modetag & ">") > 0 And InStr(Tagsval, "</" & Modetag & ">") > 0 Then
      ' Get Mode Tag Value
     Else
      Tagsval = ""
     End If
    Else
     Tagsval = Dat(Tagsval)
    End If
   End Select
   Tagsval = Replace(Replace(Replace(Replace(Tagsval, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
   If Len(Replace(Tag_Replace, " ", "")) > 0 Then
    Re = Split(Tag_Replace, "##")
    If UBound(Re) >= 0 Then Re1 = Re(0): Re2 = Re(1) Else Re1 = Re(0): Re2 = Re(0)
    Tagsval = Replace(Tagsval, Re1, Re2)
   End If
   If Len(Replace(Tag_Format, " ", "")) > 0 Then ' 格式化时间
    If IsDate(Tagsval) Then
     Tagsvalt = Tagsval: Tagsvalt = LCase(Tag_Format): Tagsvalt = Replace(Tagsvalt, "weeka", "WEEKA"): Tagsvalt = Replace(Tagsvalt, "montha", "MONTHA"): Tagsvalt = Replace(Tagsvalt, "week", "WEEK"): Tagsvalt = Replace(Tagsvalt, "month", "MONTH")
     If InStr(Tagsvalt, "WEEKA") Then Tagsvalt = Replace(Tagsvalt, "WEEKA", Lang_Week_Abbr(Weekday(Tagsval)))
     If InStr(Tagsvalt, "WEEK") Then Tagsvalt = Replace(Tagsvalt, "WEEK", Lang_Week(Weekday(Tagsval)))
     If InStr(Tagsvalt, "MONTHA") Then Tagsvalt = Replace(Tagsvalt, "MONTHA", Lang_Month_Abbr(Month(Tagsval)))
     If InStr(Tagsvalt, "MONTH") Then Tagsvalt = Replace(Tagsvalt, "MONTH", Lang_Month(Month(Tagsval)))
     If InStr(Tagsvalt, "yyyy") > 0 Then Tagsvalt = Replace(Tagsvalt, "yyyy", Year(Tagsval))
     If InStr(Tagsvalt, "yy") > 0 Then Tagsvalt = Replace(Tagsvalt, "yy", Right(Year(Tagsval), 2))
     If InStr(Tagsvalt, "mm") > 0 Then Tagsvalt = Replace(Tagsvalt, "mm", Right("0" & Month(Tagsval), 2))
     If InStr(Tagsvalt, "m") > 0 Then Tagsvalt = Replace(Tagsvalt, "m", Month(Tagsval))
     If InStr(Tagsvalt, "dd") > 0 Then Tagsvalt = Replace(Tagsvalt, "dd", Right("0" & Day(Tagsval), 2))
     If InStr(Tagsvalt, "d") > 0 Then Tagsvalt = Replace(Tagsvalt, "d", Day(Tagsval))
     If InStr(Tagsvalt, "hh") > 0 Then Tagsvalt = Replace(Tagsvalt, "hh", Right("0" & Hour(Tagsval), 2))
     If InStr(Tagsvalt, "h") > 0 Then Tagsvalt = Replace(Tagsvalt, "h", Hour(Tagsval))
     If InStr(Tagsvalt, "nn") > 0 Then Tagsvalt = Replace(Tagsvalt, "nn", Right("0" & Minute(Tagsval), 2))
     If InStr(Tagsvalt, "n") > 0 Then Tagsvalt = Replace(Tagsvalt, "n", Minute(Tagsval))
     If InStr(Tagsvalt, "ss") > 0 Then Tagsvalt = Replace(Tagsvalt, "ss", Right("0" & Second(Tagsval), 2))
     If InStr(Tagsvalt, "s") > 0 Then Tagsvalt = Replace(Tagsvalt, "s", Second(Tagsval))
     Tagsval = Tagsvalt
    End If
   End If
   If Len(Tag_Len) > 0 Then
    If IsNumeric(Tag_Len) Then
     Tag_Len = Int(Tag_Len)
     For i = 1 To Len(Tagsval)
      c = Abs(Asc(Mid(Tagsval, i, 1)))
      If c > 255 Or c < 2 Then t = t + 2 Else t = t + 1
      If t >= Tag_Len Then Tagsval = Left(Tagsval, i) & Tag_Lenext: Exit For
     Next
    End If
   End If
   If Len(Tag_Function) > 0 Then
    Tag_Function = Split(Tag_Function, ",")
    For i = 0 To UBound(Tag_Function)
     Select Case LCase(Tag_Function(i))
     Case "urlencode": Tagsval = Server.UrlEnCode(Tagsval)
     Case "htmlencode": Tagsval = Server.HtmlEnCode(Tagsval)
     Case "abs": Tagsval = Abs(Tagsval)
     Case "trim": Tagsval = Trim(Tagsval)
     Case "ucase": Tagsval = UCase(Tagsval)
     Case "lcase": Tagsval = LCase(Tagsval)
     Case "clearhtml": Tagsval = RegReplace(Tagsval, "(\<.+?\>)", ""): Tagsval = Replace(Trim(Tagsval), vbCrLf, " ")
     Case "tags"
      t = Split(Tagsval, ","): Tagsval = ""
      For c = 0 To UBound(t)
       If Len(Tagsval) > 0 Then Tagsval = Tagsval & ","
       Tagsval = Tagsval & " <a href='" & Httpurl & Installdir & "plus/search/index.asp?keyword=" & Server.UrlEnCode(t(c)) & "'>" & t(c) & "</a>"
      Next
     End Select
    Next
   End If
   If len(Tag_Width) > 0 or len(Tag_Height) > 0 then
    If instr(tag_width,",") > 0 or len(tag_width)=0 then tag_width = 100 else tag_width = int(tag_width)
    If instr(tag_height,",") > 0 or len(tag_height)=0 then tag_height = 100 else tag_height = int(tag_height)
    Tagsval = Cutjpeg(Tagsval,Tag_Width , tag_height)
   end if
   If IsNull(Tagsval) Then Tagsval = ""
   If TagTitle Then
    TagTitle = False
    Dim TitleStyle: TitleStyle = Split(Dat("Style") & ",", ",")
    If Len(TitleStyle(0)) > 0 Then Tagsval = "<" & TitleStyle(0) & ">" & Tagsval & "</" & TitleStyle(0) & ">"
    If Len(TitleStyle(1)) > 0 Then Tagsval = "<font color=""" & TitleStyle(1) & """>" & Tagsval & "</font>"
   End If
   Temp = Replace(Temp, Match.Value, Tagsval)
Next
Parser_Tags = Temp
End Function

' 判断标签
Public Function Parser_IF()
On Error Resume Next
Dim Matches, Match
Dim TestIF
Reg.Pattern = "{If:(.+?)}([\s\S]*?){Else}([\s\S]*?){End If}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
   Execute ("If " & Match.SubMatches(0) & " Then TestIf = True Else TestIf = False")
   If TestIF Then Content = Replace(Content, Match.Value, Match.SubMatches(1)) Else Content = Replace(Content, Match.Value, Match.SubMatches(2)) ' 替换
   If Err Then Response.Write "<font color=red>" & Lang_Parser_IF_Error & "[" & Match.SubMatches(0) & "]" & Err.Description & "</font>": Err.Clear: Response.End
Next
Reg.Pattern = "{If:(.+?)}([\s\S]*?){End If}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
   Execute ("If " & Match.SubMatches(0) & " Then TestIf = True Else TestIf = False")
   If TestIF Then Content = Replace(Content, Match.Value, Match.SubMatches(1)) Else Content = Replace(Content, Match.Value, "") ' 替换
   If Err Then Response.Write "<font color=red>" & Lang_Parser_IF_Error & "[" & Match.SubMatches(0) & "]" & Err.Description & "</font>": Err.Clear: Response.End
Next
End Function

' 正表达式替换
Public Function RegReplace(ByVal ReplaceContent, ByVal Pattern, ByVal ReplaceVal)
Reg.Pattern = Pattern
RegReplace = Reg.Replace(ReplaceContent, ReplaceVal)
End Function

' 是否存在此类标签
Public Function RegExists(ByVal Pattern, ByVal TestContent)
Reg.Pattern = Pattern
RegExists = Reg.Test(TestContent)
End Function

' 获取指定标签属性的值
'Tag_Cache = GetAttr(" $row=10 $cid={field:cid} $mode=commend ", "cache", True)
Public Function GetAttr(ByVal Tagsstr, ByVal AttrName, ByVal ReplaceSpace)
If Len(Tagsstr) <= 3 Or InStr(LCase(Tagsstr), "$" & LCase(AttrName) & "=") = 0 Then GetAttr = "": Exit Function
Dim Matches, Match
Reg.Pattern = "\$" & AttrName & "=(.+?) \$"
Set Matches = Reg.Execute(Tagsstr & " $")
For Each Match In Matches
   GetAttr = Match.SubMatches(0)
Next
If ReplaceSpace Then
   GetAttr = Replace(GetAttr, " ", "")
   If Len(GetAttr) > 0 And IsNumeric(GetAttr) And InStr(GetAttr, ",") = 0 Then GetAttr = Int(GetAttr)
End If
End Function

' 载入模板
Public Function Loadfile()
Dim Obj
On Error Resume Next
Set Obj = Server.CreateObject("adodb.stream")
With Obj
.Type = 2: .Mode = 3: .Open: .Charset = Response.charset : .Position = Obj.Size: .Loadfromfile Server.Mappath(Template): Content = .ReadText: .Close
End With
Set Obj = Nothing
If Err Then Response.Write "<font color=red>" & Lang_Parser_LoadFile_Error & "[" & Template & "]</font>": Response.End
End Function

public function rep(s,d)
content = replace(content,s,d)
end function


End Class

%>

Function ProcessCustomTags(ByVal sContent)
Dim objRegEx, Match, Matches
Set objRegEx = New RegExp
objRegEx.Pattern = "<tag:[^<>]+?\/>"
objRegEx.IgnoreCase = True
objRegEx.Global = True
Set Matches = objRegEx.Execute(sContent)
For Each Match in Matches
sContent = Replace(sContent, Match.Value, ParseTag(Match.Value))
Next
set Matches = nothing
set objRegEx = nothing
ProcessCustomTags = sContent
End Function

function ParseTag(ByVal strTag)
dim arrResult, ClassName, arrAttributes, sTemp, i, objClass
if len(strTag) = 0 then exit function
arrResult = Split(strTag, ":")
ClassName = Split(arrResult(1), " ")(0)
select case uCase(ClassName)
case "LOOP"
'response.write GetAttribute("channelid", strTag) & "<br>"
'response.write GetAttribute("pagesize", strTag) & "<br>"
'response.write GetAttribute("title", strTag) & "<br>"
'response.write GetAttribute("elite", strTag) & "<br>"
'response.write GetAttribute("column", strTag) & "<br>"
for i = 1 to GetAttribute("pagesize", strTag)
   t = replace(text,"{{id}}",i)
   t = replace(t,"{{title}}", i & "title")
   ParseTag = ParseTag & t & Vbcrlf
next

case "ARTICLE"
'response.write GetAttribute("id", strTag) & "<br>"
'response.write GetAttribute("content", strTag) & "<br>"
end select
end function

function GetAttribute(ByVal strAttribute, ByVal strTag)
Dim objRegEx, Matches
Set objRegEx = New RegExp
objRegEx.Pattern = lCase(strAttribute) & "=""[0-9a-zA-Z]*"""
objRegEx.IgnoreCase = True
objRegEx.Global = True
Set Matches = objRegEx.Execute(strTag)
if Matches.Count > 0 then
GetAttribute = Split(Matches(0).Value,"""")(1)
else
GetAttribute = ""
end if
set Matches = nothing
set objRegEx = nothing
end function

配合缓存类：

class clsCache
private cache
private cacheName
private expireTime
private expireTimeName
private path

private sub class_initialize()
path=request.servervariables("url")
path=left(path,instrRev(path,"/"))
end sub

private sub class_terminate()
end sub

Public Property Get Version
Version=""
End Property

public property get valid
if isempty(cache) or (not isdate(expireTime)) or (CDate(expireTime)<now) then
vaild=false : clean()
else
valid=true
end if
end property

public property get value
if isempty(cache) or (not isDate(expireTime)) then
value=null
elseif CDate(expireTime)<now then
value=null
else
value=cache
end if
end property

public property let name(str)
cacheName=str&path
cache=application(cacheName)
expireTimeName=str&"expire"&path
expireTime=application(expireTimeName)
end property

public property let expire(tm)
expireTime=tm
application.Lock()
application(expireTimeName) =expireTime
application.UnLock()
end property

public sub add(varCache,varExpireTime)
if isempty(varCache) or not isDate(varExpireTime) then
exit sub
end if
cache=varCache
expireTime=varExpireTime
application.lock
application(cacheName)=cache
application(expireTimeName)=expireTime
application.unlock
end sub

public sub clean()
application.lock
application(cacheName)=empty
application(expireTimeName)=empty
Application.Contents.Remove(cacheName)
Application.Contents.Remove(expireTimeName)
application.unlock
cache=empty
expireTime=empty
end sub

public function verify(varcache2)
if typename(cache)<>typename(varcache2) then
verify=false
elseif typename(cache)="Object" then
if cache is varcache2 then
   verify=true
else
   verify=false
end if
elseif typename(cache)="Variant()" then
if join(cache,"^")=join(varcache2,"^") then
   verify=true
else
   verify=false
end if
else
if cache=varcache2 then
   verify=true
else
   verify=false
end if
end if
end function
end class

1，WITH TEMPLET意思是，生成的页面架构将采用某个已设定的模板，在此之前我的一篇教程中介绍过，希望各位在看本教程之前对ASP采用模板应熟悉下。（当然，不看也没有问题，本教程同样会提及精华部分的：）

那么，我现在需要处理的技术问题就是：

1，如何实现模板技术？（先参看下上篇文章吧）

2，如何实现2HTML技术？

3，如何让模板技术与2HTML技术结合？

一、先进行技术原理分析

1，模板技术

2，2HTML技术又该如何实现呢？如何使得ASP页面转变为HTML？一般都会想到FSO组件，因为该组件能新建任何文件格式。

那么其整个运行过程是怎么样的呢？

a，提供信息输入页面进行信息收集；

b，接受信息值先保存数据库，再FSO生成文件；

c，技术性完成任务，显示刚被创建的HTML文件的路径地址。

该技术的实现过程中有如下几个难点：

i，FSO生成的文件是直接放在一个大文件夹下，还是单独放在某个每日更新的子文件夹中？可能表述不准确，这样理解吧：相信通过FSO生成的文件随着时间的推移，文件会越来越多，管理也会越来越乱……通常你可能看到一些地址诸如 http://www.xxx.com/a/2004-5-20/200405201111.html   可以分析得出应该是建立了当前日期的文件夹。这样，一天就是一个文件夹的页面内容，查看管理也就显得比较合理。

ii，我在试图通过以上方法建立文件夹的时候，又发现了第二个问题。第一次通过FSO建立以当前日期命名的文件夹，没有问题。当我有新的文件需要生成时，因为是同一个程序，所以，其又将会执行建立同样的文件夹。此时，FSO组件会发现该路径已存在……卡壳-_-! 继续处理，在首行添加代码：

On Error Resume Next

嘿嘿，达到自欺欺人、掩耳盗铃的效果。

iii，文件夹是建立了，文件该如何建立呢？主要也就是文件名的生成。当然这个就需要自己来写个函数，功能就是如何生成文件名：）

<%

function makefilename(fname)

fname = fname '前fname为变量，后fname为函数参数引用

fname = replace(fname,"-","")

fname = replace(fname," ","")

fname = replace(fname,":","")

fname = replace(fname,"PM","")

fname = replace(fname,"AM","")

fname = replace(fname,"上午","")

fname = replace(fname,"下午","")

makefilename = fname & ".html"

end function

%>

引用函数则：

<%fname = makefilename(now())%>

其实嘛，就是以年月日时分秒命名的文件。

iv，最后，生成的文件该如何查看到？当然需要把生成文件的路径保存的数据库中，并且添加到相对应的记录集中了。当然，这在下面的数据库设计时会提及到。

3，模板技术和2HTML技术的结合：将模板中特殊代码的值替换为从表单接受过来的值，完成模板功能；将最终替换过的所有模板代码生成HTML文件。需要注意的是：替换应能将输入数据的格式或者支持UBB的代码彻底改变。

二，再进行数据库设计

目前数据库的设计需要两个表：一个是存放模板数据的；一个是存放信息内容的。

1，建立新数据库asp2html.mdb

2，设计新数据库表c_moban

字段m_id（自动编号，主关键字）；字段m_html（备注类型）。

并将下列完整的代码拷贝至m_html字段

<html>

<head>

<meta http-equiv="Content-Type" content="text/html; charset=hz">

<title>Cnbruce.Com | ASP2HTML TEST</title>

</head>

<body leftmargin="0" topmargin="0">

<table width="100%" height="100%" border="0" cellpadding="5" cellspacing="2">

<tr align="right" bgcolor="#CCCCCC">

    <td height="20" colspan="2">$cntop$</td>

</tr>

<tr valign="top">

    <td width="25%" bgcolor="#e5e5e5">$cnleft$</td>

    <td width="74%" bgcolor="#f3f3f3">$cnright$</td>

</tr>

</table>

</body>

</html>

3，设计新数据库表c_news

字段c_id：自动编号，主关键字

字段c_title：文本类型，保存文章标题

字段c_content：备注类型，保存文章内容

字段c_filepath：文本类型，保持生成文件的路径地址

字段c_time：日期/时间类型，默认值：Now()

三，页面需求设计

1，首先建立一个存放HTML页的文件夹

在文件同一目录下，建立文件夹newsfile，夹子内部主要存放生成的HTML页面，当然内部还会采用程序方式建立以日期命名的子文件夹，以方便浏览以及管理。

2，功能函数页面lib.asp

<%

'生成文件名的函数

function makefilename(fname)

fname = fname

fname = replace(fname,"-","")

fname = replace(fname," ","")

fname = replace(fname,":","")

fname = replace(fname,"PM","")

fname = replace(fname,"AM","")

fname = replace(fname,"上午","")

fname = replace(fname,"下午","")

makefilename=fname & ".shtml"

end function

'保持数据格式不变的函数

Function htmlencode(fString)
'If not isnull(fString) then
'fString = replace(fString, ">", ">")
'fString = replace(fString, "<", "<")
'fString = Replace(fString, CHR(32), " ")
'fString = Replace(fString, CHR(9), " ")
'fString = Replace(fString, CHR(34), """)
'fString = Replace(fString, CHR(39), "'")
'fString = Replace(fString, CHR(13), "")
'fString = Replace(fString, CHR(10) & CHR(10), "</p><p> ")
'fString = Replace(fString, CHR(10), "<br> ")

If Not IsNull(fString) Then
fString = trim(fString)
fString = replace(fString, ";", "；")     '分号过滤
fString = replace(fString, "--", "——") '--过滤
fString = replace(fString, "%20", "")    '特殊字符过滤
fString = replace(fString, "==", "")     '==过滤
fString = replace(fString, ">", "&gt;")
fString = replace(fString, "<", "&lt;")
fString = Replace(fString, CHR(32), " ")   '&nbsp;
fString = Replace(fString, CHR(9), " ")    '&nbsp;
fString = Replace(fString, CHR(34), "&quot;")
fString = Replace(fString, CHR(39), "&#39;") '单引号过滤
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")

htmlencode = fString
End If
End Function

Function uhtmlencode(fString)
If not isnull(fString) then
fString = Replace(fString, " ", CHR(32))
fString = Replace(fString, " ", CHR(9))
fString = Replace(fString, "&#34;", CHR(34))
fString = Replace(fString, "&#39;", CHR(39))
fString = Replace(fString, "", CHR(13))
fString = Replace(fString, "</p><p> ", CHR(10) & CHR(10))
fString = Replace(fString, "<br> ", CHR(10))
uhtmlencode = fString
End If
End Function

%>

3，数据库连接页面conn.asp

完成数据库的字符串连接方法

<%

set conn = Server.CreateObject("ADODB.Connection")

connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath("asp2html.mdb")

conn.Open connstr

%>

4，信息输入页面add.html

其实很简单：）就是表单嘛。注意action是跳转到addit.asp

<form action="addit.asp" method="post">

title:<input type="text" ><br>

Content:<br>

<textarea rows="8" cols="30"></textarea><br>

<input type="submit" value="Add">

<input type="reset" value="Reset">

</form>

5，处理数据功能显示页面addit.asp

首先是处理接受过来的数据，并将值写入数据库；接着将模板代码进行引用，并将其中特殊代码转换为接受值，最终通过FSO生成HTML页面。其中需要注意的还有，生成文件的路径地址保存至数据库表。

<%'容错处理

On Error Resume Next

%>

<!--#include file="conn.asp" -->

<!--#include file="lib.asp" -->

<%'接受传递值

c_title=request.form("c_title")

c_content=request.form("c_content")

%>

<%'生成HTML文件名，建立文件夹，指定文件路径

fname = makefilename(now())   'makefilename为自定义函数

folder = "newsfile/"&date()&"/"

filepath = folder&fname

%>

<%'将接受值及路径保持至数据库表

sql = "Select * from c_news"

Set rs = Server.CreateObject ("ADODB.Recordset")

rs.Open sql,conn,3,2

rs.addnew

rs("c_title")=c_title

rs("c_content")=c_content

rs("c_filepath")=filepath

rs.update

rs.close

Set rs = Nothing

%>

<%'打开模板代码，并将其中特殊代码转变为接受值

sql1="select m_id,m_html from c_moban where m_id=1"

set rs1=Server.CreateObject("adodb.recordset")

rs1.open sql1,conn,1,1

mb_code=rs1("m_html")

rs1.close

set rs1=nothing

conn.close

set conn=nothing

c_title=htmlencode(c_title)

c_content=htmlencode(c_content)

mb_code=replace(mb_code,"$cntop$",now())

mb_code=replace(mb_code,"$cnleft$",c_title)

mb_code=replace(mb_code,"$cnright$",c_content)

%>

<%'生成HTML页面

Set fso = Server.CreateObject("Scripting.FileSystemObject")

fso.CreateFolder(Server.MapPath(folder))

Set fout = fso.CreateTextFile(Server.MapPath(filepath))

fout.WriteLine mb_code

fout.close

%>

文章添加成功，<a href="showit.asp">浏览</a>

6，显示数据库表记录，并做指向HTML页的链接：showit.asp

<!--#include file="conn.asp" -->

<!--#include file="lib.asp" -->

<%

Set rs = Server.CreateObject ("ADODB.Recordset")

sql = "Select * from c_news order by c_id desc"

rs.Open sql,conn,1,1

%>

<%

if rs.EOF and rs.BOF then

   response.write ("暂时还没有文章，<a href=add.html>添加</a>")

else

   Do Until rs.EOF

%>

        <table width="758" border="0" align="center" cellpadding="3" cellspacing="1" bgcolor="#000000">

            <tr>

            <td width="159" align="right" bordercolor="#CCCCCC" bgcolor="#CCCCCC"><%=rs("c_time")%></td>

            <td width="591" bordercolor="#f3f3f3" bgcolor="#f3f3f3"><a href=<%=rs("c_filepath")%> target="a_blank"><%=rs("c_title")%></a></td>

          </tr>

          <tr>

            <td valign="top" align="right" bordercolor="#ececec" bgcolor="#ececec">[<a href=del.asp?c_id=<%=rs("c_id")%>>Dell</a>][<a href=change.asp?c_id=<%=rs("c_id")%>>Edit</a>][<a href="add.html">Add</a>]</td>

            <td valign="top" bordercolor="#FFFFFF" bgcolor="#FFFFFF"><%=htmlencode(rs("c_content"))%></td>

          </tr>

        </table><br>

<%

      rs.MoveNext

   Loop

end if

%>

<%

rs.close

Set rs = Nothing

conn.close

set conn=Nothing

%>

7，修改数据内容页change.asp

修改数据内容，同时也需要修改更新对应的HTML页面。修改其实就是重新生成文件，且文件名和之前一样，类似文件的覆盖。

<!--#include file="conn.asp" -->

<!--#include file="lib.asp" -->

<%id=request.querystring("c_id")%>

<%

if request.form("submit")="change" then

c_title=request.form("c_title")

c_content=request.form("c_content")

c_id=request.form("c_id")

c_filepath=request.form("c_filepath")

Set rs = Server.CreateObject ("ADODB.Recordset")

sql = "Select * from c_news where c_id="&c_id

rs.Open sql,conn,3,2

rs("c_title")=c_title

rs("c_content")=c_content

rs("c_time")=now()

rs.update

rs.close

Set rs = Nothing

%>

<%'打开模板代码，并将其中特殊代码转变为接受值

sql1="select m_id,m_html from c_moban where m_id=1"

set rs1=Server.CreateObject("adodb.recordset")

rs1.open sql1,conn,1,1

mb_code=rs1("m_html")

rs1.close

set rs1=nothing

conn.close

set conn=nothing

c_title=htmlencode(c_title)

c_content=htmlencode(c_content)

mb_code=replace(mb_code,"$cntop$",now())

mb_code=replace(mb_code,"$cnleft$",c_title)

mb_code=replace(mb_code,"$cnright$",c_content)

%>

<%'生成HTML页面

Set fso = Server.CreateObject("Scripting.FileSystemObject")

Set fout = fso.CreateTextFile(Server.MapPath(c_filepath))

fout.WriteLine mb_code

fout.close

%>

<%response.redirect("showit.asp")%>

<%end if%>

<%

if id<>"" then

    Set rs = Server.CreateObject ("ADODB.Recordset")

    sql="select * from c_news where c_id="&id

    rs.Open sql,conn,1,1

    c_id=rs("c_id")

    c_filepath=rs("c_filepath")

    c_title=rs("c_title")

    c_content=rs("c_content")

end if

%>

<form action="change.asp" method="post">

title:<input type="text" value=<%=c_title%>><br>

Content:<br>

<textarea rows="8" cols="30"><%=c_content%></textarea><br>

<input type="submit" value="change" >

<input type="reset" value="Reset">

<input type="hidden" value="<%=id%>">

<input type="hidden" value="<%=c_filepath%>">

</form>

8，删除记录页del.asp

同样！删除，除了删除数据库表中的记录，与其对应的HTML页面也需删除。代码如下：

<!--#include file="conn.asp" -->

<%

c_id = request.querystring("c_id")

sql = "Select * from c_news where c_id="&c_id

Set rs = Server.CreateObject ("ADODB.Recordset")

rs.Open sql,conn,2,3

filepath=rs("c_filepath")

Set fso = CreateObject("Scripting.FileSystemObject")

fso.DeleteFile(Server.mappath(filepath))

Set fso = nothing

rs.delete

rs.close

Set rs = Nothing

conn.close

set conn=nothing

%>

<%response.redirect("showit.asp")%>

四，其它功能

模板管理页面：

不会每次都是打开数据库表进行增加或者修改模板代码吧，所以，管理代码的页面程序不能少了，自己捣鼓下应该很简单的。当然，之前管理员的登录认证程序就不在书中交代了：）还有，如果设计了多个模板，那么在发表信息的时候应添加模板选择单选框，同样在执行转换HTML时，SQL选择的不同m_id了。

第二个文件  
  //没有对文件名处理  
  <%  
        Response.Expires   =   0    
        dim   ado_stream  
        dim   xml_dom  
   
        set   xml_dom   =   Server.CreateObject("MSXML2.DOMDocument")  
        xml_dom.load(request)  
        for   i=   0   to   (xml_dom.documentElement.childNodes.length   -1)  
                set   list=xml_dom.documentElement.childNodes.item(i)  
                saveas   list            
        next  
   
  sub   savetodb()  
          set   con=session("con")  
   
  end   sub  
   
  sub   saveas(nd)    
        set   ado_stream   =   Server.CreateObject("ADODB.Stream")  
        ado_stream.Type   =   1      
        ado_stream.open    
        ado_stream.Write   nd.nodeTypedValue  
        ado_stream.SaveToFile   "c:\1.vbs",2      
        ado_stream.close  
        set   ado_stream   =   Nothing    
  end   sub  
   
        set   xml_dom   =   Nothing  
        Response.Write   "上传成功"  
  %>  

//原来你要保存到数据库  
  第二个文件的补丁  
  sub   savetodb(nd)  
          set   rs=server.CreateObject("adodb.recordset")  
          rs.Open   "SELECT   *   FROM   xxx",con,1,3  
          rs.addnew  
          rs("fujian").AppendChunk   nd.nodeTypedValue    
          rs("fjmc")=   "1.vbs"   //文件名称你可以想办法获得，如果你不懂xml就有点麻烦  
          rs("fjsx")   =   "application/octet-stream"   //很显然，这是个重要的东西，不然输出就麻烦了  
          rs.update  
          rs.close  
          set   rs=nothing  
          set   con=nothing  
  end   sub