ASP模板类（VBScript实现）

看这篇文章的内容之前，请大家先看看沐枫小筑的文章--《ASP网页模板的应用: 让程序和界面分离，让ASP脚本更清晰，更换界面更容易》，这个老小子用JScript实现了一个模板类

 http://blog.csdn.net/muf/archive/2002/05/08/10012.aspx

感觉功能还不错，不过网上复制的时候，好像我还复制错了。

经过一段时间的调试，我把他的模版类给改成了vbscript的了。这里共享一下，使用了一个dictionary 字典实现了那个家伙的功能，下面是源代码，有什么问题请看源代码，我没有时间给你们解释任何东西:

<%'---------------------------------------------------------------
' AspStudio_Codepage="936"
' 上面这行是软件使用的代码页标记，请不要删除。详情请参考帮助文件。
'
' 档案名称：cls_MyTemplate.asp
' 原创作者：糯米糊糊
' 作者邮件：[email protected]
' 创建日期：星期三，2006年03月22日 10:29:58
' 版权所有(C)糯米糊糊
'--------------------------------------------------------------
'***************************************************
' 类名：MyTemplate
' 作用：读取模板
' 作者：糯米糊糊，2006年
' 引用： 无引用,修改沐枫的JScript的Template类,改成了VBScript
'***************************************************

 
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 = CreateObject("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"">" & strEcho & "</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 " & varname &"<br>"

If Dic.Item(varName) = Empty Then
  Response.Write  varname &" 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 & m.Value & vbNewLine
        Set sms = m.SubMatches
'        For j = 0 To sms.Count - 1
'            r = r & sms.Item(j) & vbNewLine
'        Next j
        Dic.Item(sms.Item(0)) = sms.Item(1)
    Next ' m
    'MsgBox r
   

    End If
    s = "{" & sms.Item(0) & "}"
    '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.CreateObject("Scripting.FileSystemObject") 'New FileSystemObject

Dim Pathfile 'As String
Pathfile = fso.BuildPath(TplPath, filename)
Response.Write Server.MapPath(Pathfile) & "<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("& varName&")="
    Response.Write "laod file success "
    Set f = Nothing
else
  Response.Write Pathfile & " ----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 = "Select * From Template Where TemplateName='" & TemplateName & "'"
'Response.Write sqlTemplate

    If Not IsObject(Conn) Then
      DBPath = "./"             
      DBFile = "data/BlogData.mdb"
      ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(""& DbPath & "" & DbFile & "")
      'Response.Write ConnStr
      Set Conn=Server.CreateObject("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.CreateObject("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 " &cstr(objDic.count) & "Items<br>"
'for i=objDic.count-1 to 0 step -1
'response.Write "Index "&CStr(i)&"-" & a(i) & ":" & objDic.Item(a(i))& "<br>--------------------------------------<br>"
'response.Write a(i) & 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>" & tpl.dic.Item(a(i))& "<br>--------------------------------------<br>"
'response.Write a(i) & 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