淡水河边的博客

<%
" 档案名称：cls_MyTemplate.asp
" 原创作者：胡传照

Class MyTemplate

Private m_strError " 出错信息
Private m_strVersion " 版本号
Private m_strVersionName " 版本名称

Private m_strClassName " 类的名称

Private mvarTplPath "As Variant "local copy
Private objDic "As Scripting.Dictionary "local copy


" 类初始化
Private Sub Class_Initialize()
m_strError = ""
m_strVersion = "0.1"
m_strVersionName = "Alpha 0.1版"
m_strClassName = ""
Set Dic = Cr&#101;ateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare

End Sub
" 类释放
Private Sub Class_Terminate()
Set Dic = Nothing
m_strError = ""
m_strVersion = ""
m_strVersionName = ""
m_strName = ""
End Sub



"-----读写各个属性---------------------------
Public Property Get ClassName()
ClassName = m_strClassName
End Property

Public Property Let ClassName(strName)
m_strClassName = strName
End Property

"-----------------------------------------------

" 获取错误信息
Public Function GetLastError()
GetLastError = m_strError
End Function

" 私有方法，添加错误信息
Private Sub AddErr(strEcho)
m_strError = m_strError + "<Div CLASS=""alert"">" &amp; strEcho &amp; "</Div>"
End Sub

" 清除错误信息
Public Function ClearError()
m_strError = ""
End Function




Public Function Parse(varName) " As String) As String
Dim mc "As MatchCollection
Dim m "As Match
"Dim sms "As SubMatches
Dim i
If Dic.Item(varName) = Empty Then
    Parse = ""
Else
    Dim reg "As RegExp
    Set reg = New RegExp
    reg.Global = True
    reg.MultiLine = True
    reg.IgnoreCase = True
    
    reg.Pattern = "{(\w*)}"
    Dim strResult "As String
    strResult = Dic.Item(varName)
   Set mc = reg.Execute(strResult)
    
    If mc.Count >= 1 Then
        For i = 0 To mc.Count - 1
            Set m = mc.Item(i)
            Key = Mid(m.Value, 2, Len(m.Value) - 2)
            reg.Pattern = m.Value
            If Not IsEmpty(Dic.Item(Key)) Then
               strResult = reg.Replace(strResult, Dic.Item(Key))
            End If
                    Set m = Nothing
        Next
    End If
     Set mc = Nothing
     Set reg = Nothing
    
    Parse = strResult
End If

End Function


Public Sub SplitVars(varName) "As String)
Dim lenth "As Integer
Dim mc "As MatchCollection
Dim m "As Match
Dim sms "As SubMatches

"Response.Write "test " &amp; varname &amp;"<br>"

If Dic.Item(varName) = Empty Then
  Response.Write  varname &amp;" is empty"
  Exit Sub
End If



Dim Template_Exp "As RegExp
Set Template_Exp = New RegExp
"Template_Exp.Global = True
Template_Exp.IgnoreCase = True

"<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND+\1 *-->
"<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND +\1 *-->

Template_Exp.Pattern = "<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND +\1 *-->"

While Template_Exp.Test(Dic.Item(varName)) <> False
    Set mc = Template_Exp.Execute(Dic.Item(varName))
    If mc.Count >= 1 Then
    "mc.Item(0) = mc.Item(1)
    For Each m In mc
        "r = r &amp; m.Value &amp; vbNewLine
        Set sms = m.SubMatches
"        For j = 0 To sms.Count - 1
"            r = r &amp; sms.Item(j) &amp; vbNewLine
"        Next j
        Dic.Item(sms.Item(0)) = sms.Item(1)
    Next " m
    "MsgBox r
  End If
    s = "{" &amp; sms.Item(0) &amp; "}"
    "MsgBox s
    Dic.Item(varName) = Template_Exp.Replace(Dic.Item(varName), s)
   " MsgBox Dic.Item(varName), , "Dic.Item(varName)"
    s = sms.Item(0)
    Set sms = Nothing
     Set mc = Nothing
    
    SplitVars (s)
     "Set Template_Exp = Nothing
Wend


End Sub

Public Sub LoadFile(varName, filename)  "(varName As String, filename As String)
Dim fso "As Scripting.FileSystemObject
Set fso = Server.Cr&#101;ateObject("Scripting.FileSystemObject") "New FileSystemObject

Dim Pathfile "As String
Pathfile = fso.BuildPath(TplPath, filename)
Response.Write Server.MapPath(Pathfile) &amp; "<br>"
If fso.FileExists(Server.MapPath(Pathfile)) Then
    
    Set f = fso.OpenTextFile(Server.MapPath(Pathfile), 1)
    Dic.RemoveAll
    Dic.Item(varName) = f.ReadAll()
    Response.Write "Dic.Item("&amp; varName&amp;")="
    Response.Write "laod file success "
    Set f = Nothing
else
  Response.Write Pathfile &amp; " ----Do not Exist<br>"
  Response.Write "load file faild"  
End If
Pathfile = ""
Set fso = Nothing
End Sub


Public Sub LoadAccess(varName, TemplateName)  "(varName As String, TemplateName As String)
sqlTemplate = "Sel&#101;ct * From Template Wh&#101;re TemplateName="" &amp; TemplateName &amp; """
"Response.Write sqlTemplate
   If Not IsObject(Conn) Then
      DBPath = "./"              
      DBFile = "data/BlogData.mdb"
      ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &amp; Server.MapPath(""&amp; DbPath &amp; "" &amp; DbFile &amp; "")
      "Response.Write ConnStr
      Set Conn=Server.Cr&#101;ateObject("ADODB.Connection")
      Conn.open ConnStr
      If Err Then
          Err.Clear
          Set Conn = Nothing
          
          AddErr "数据库连接出错，请检查连接字串。"
          Response.Write GetLastError
          "Response.Write Err
          Dic.Item(varName) = "加载数据失败，请检查数据库连接是否正确"  
          "Response.End        
      End If

    End If
    
    Set rsTemplate = Server.Cr&#101;ateObject("Adodb.Recordset")                        
      rsTemplate.Open sqlTemplate, Conn, 1, 1
      Dic.Item(varName) = rsTemplate("TemplateHtml")
      rsTemplate.Close
    Set rsTemplate = Nothing

End Sub

Public Property Let TplPath(vData) "(ByVal vData) "As Variant)
    mvarTplPath = vData
End Property


"Public Property Set TplPath(vData)"(ByVal vData) "As Variant)
"    Set mvarTplPath = vData
"End Property


Public Property Get TplPath() "As Variant
    "If IsObject(mvarTplPath) Then
     "   Set TplPath = mvarTplPath
    "Else
        TplPath = mvarTplPath
    "End If
End Property


"Public Property Let Dic(vData)"(ByVal vData) "As Variant)
"    objDic = vData
"End Property


Public Property Set Dic(vData) "(ByVal vData) "As Variant)
    Set objDic = vData
End Property
Public Property Get Dic() "As Variant
    If IsObject(objDic) Then
"a=objDic.Keys
"response.Write "In Dic there are " &amp;cstr(objDic.count) &amp; "Items<br>"
"for i=objDic.count-1 to 0 step -1
"response.Write "Index "&amp;CStr(i)&amp;"-" &amp; a(i) &amp; ":" &amp; objDic.Item(a(i))&amp; "<br>--------------------------------------<br>"
"response.Write a(i) &amp; vbNewline
"
"next
        Set Dic = objDic
    Else
        Dic = objDic
    End If
End Property

End Class
%>

调试的时候使用了VB来调试，所以里面有很多VB的代码，但是都注释掉了，不影响使用。

使用和沐风的那个差不多。

例子：

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

Dim tpl "As MyTemplate
Set tpl = New MyTemplate
tpl.TplPath = "E:\Webs\hublog\template"
"tpl.LoadFile "Main", "blogview.htm"
tpl.LoadAccess "Main","default"
TplLoadTimes=TplLoadTimes+1
tpl.SplitVars ("Main")

"a=tpl.Dic.Keys
"response.Write "ssssssssssssssssssssssssssssssssssssssssssssss"
"for i=tpl.Dic.count-1 to 0 step -1
"response.Write a(i)
"response.Write  "::::--->>><br>" &amp; tpl.dic.Item(a(i))&amp; "<br>--------------------------------------<br>"
"response.Write a(i) &amp; vbNewline
"tpl.Dic.Item(a(i))=tpl.Parse(a(i))
"next
Dim ss

"tpl.Dic.Item("TITLE") =tpl.Parse("TITLE")
ss = objMyBlogArticle.Title
tpl.Dic.Item("TITLE") =CheckEmptyStr(ss,"标题未设置")
"tpl.Dic.Item("AUTHOR") =tpl.Parse("AUTHOR")
ss = objMyBlogArticle.Author
tpl.Dic.Item("AUTHOR") = CheckEmptyStr(ss,"作者不详")
"tpl.Dic.Item("CONTENT") = tpl.Parse("CONTENT")
ss = objMyBlogArticle.Content
tpl.Dic.Item("CONTENT") = CheckEmptyStr(ss,"请更新数据")
"tpl.Dic.Item("POSTTIME") = tpl.Parse("POSTTIME")
ss = objMyBlogArticle.PostTime
tpl.Dic.Item("POSTTIME") =CheckEmptyStr(ss,"请更新数据")

tpl.Dic.Item("ARTICLE") = tpl.Parse("ARTICLE")
"response.Write tpl.Parse("TITLE")
"response.Write tpl.Parse("ARTICLE")
response.Write tpl.Parse("Main")
Set tpl = Nothing
else
Response.Write "文章不存在!"
End if

Set objMyBlogArticle = Nothing%>

----------------------------

blogview.htm自己去填，有时间的话我再贴上来，没时间就算了

loadaccess中的tpl.LoadAccess "Main","default"，default是一个模版的名字，内容是blogview.htm