ASP页面模板对象[彭国辉]

<%
'================================================================
' CLASS NAME:  kktTemplate ASP页面模板对象
' DESIGN BY :     彭国辉
' DATE:                 2004-07-05
' WEBSITE:          http://kacarton.yeah.net/
' BLOG:                http://blog.youkuaiyun.com/nhconch
' EMAIL:              kacarton@sohu.com
'
' 本对象中使用了set_var、set_block等命名方法是为了兼容phplib
'文章为作者原创，转载前请先与本人联系，转载请注明文章出处、保留作者信息，谢谢支持！
'　　给出具体代码之前，先把主要函数列出，用过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 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))    '指定的文件夹存在返回 True，不存在返回 False
        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 & "不存在!")        'FileExists方法:指定文件存在返回 True ;否则返回 False 。
        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
        'Pattern属性设置或返回被搜索的正则表达式模式
        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
%>