实现代码：
<% ‘================================================================ ‘ 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 %> |
分页: [1] [2] [3] [4]
TAG: 模板 ASP代码 页面