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-05br>" vbCrLf _ "個人網站：a 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 %>
