ASP的模板类，支持动态加载类及模板赋值

看见很多兄弟们的个人站还是用asp混合html方式，忍不住放出自己写的ASP的模板类，支持动态加载类及模板赋值。

<%
'*************************************************************
'* 视图类
'*************************************************************
'* @category  FlapSite
'* @package   Flap_Controller
'* @copyright Copyright (c) morphyyang.com
'* @license   MIT-license
'* @link      http://www.morphyyang.com/flapsite
'* @author    morphy morphyyang@163.com
'*************************************************************
Class Nis_View_Main

    '模板变量代码缓存
    '@access private
    '@var string
    Private strTplVars

    '模板扩展名称
    '@access private
    '@var string
    Private strTplExt

    '模板存放路径,当存在全局变量strTplPath时无效
    '@access private
    '@var string
    Private strTplPath

    '模板变量存放对象
    '@access private
    '@var object 对象Scripting.Dictionary
    Private objTplVars

    '请求类
    '@access private
    '@var Nis_Controller_Request
    Private objRequest

    '已经加载的类文件
    '@access private
    '@var array
    Private arrInclude(20)

    '已经加载的类对象实例
    '@access private
    '@var array
    Private arrClass(20)

    '*************************************************************
    '* 构造函数
    '* THEME_APP及THEME_ADMIN为全局常量
    '*************************************************************
    '* @access public
    '* @param  void
    '* @return void
    '*************************************************************
    Public Sub class_initialize()
        strTplVars = ""
        strTplExt  = ".tpl.asp"
        '初始化模板变量存储对象
        Set objTplVars = CreateObject("Scripting.Dictionary")
        '初始化模板存放路径
        Set objRequest = new Nis_Controller_Request
        '设置模板路径
        strTplPath = objRequest.getTplDir()
    End Sub

    '*************************************************************
    '* 设置模板扩展名
    '*************************************************************
    '* @access public
    '* @param string strExt 模板文件扩展名
    '* @return void
    '************************************************************* 
    Public Property Let tplExt(strExt)
        If IsEmpty(strExt) Then
            strExt = ".tpl.asp"
        End If
        strTplExt = strExt
    End Property

    '*************************************************************
    '* 设置模板路径
    '*************************************************************
    '* @access public
    '* @param string strPath 模板文件存放路径
    '* @return void
    '************************************************************* 
    Public Property Let tplPath(strPath)
        If IsEmpty(strPath) Then
            strPath = ""
        End If
        strTplPath = strPath
    End Property

    '*************************************************************
    '* 模板变量赋值
    '*************************************************************
    '* @access public
    '* @param string strKey 模板变量名称
    '* @param mixed mixDefault 模板变量值
    '* @return void
    '*************************************************************
    Public Sub assign(strKey, mixValue)
        Call objTplVars.add(strKey, mixValue)
    End Sub

    '*************************************************************
    '* 根据提供的类名称自动寻找所在文件并同时定义加载类
    '*************************************************************
    '* @access public
    '* @param  string strClass 类名称
    '* @param  string strFun 类成员名称
    '* @param  string arrParams 类成员参数
    '* @param  string strType 调用类成员类型
    '* @return void
    '*************************************************************
    Public Function tag(strClass,strFun,arrParams,strType)
        Dim objReg, strContent, intAspStart, intAspEnd
        Dim strInclude, strDim, intCount, intInclude
        Dim bolInclude : bolInclude = False
        '用来承载asp以外的内容,将忽略输出
        Dim strReturn : strReturn = ""
        '判断是否加载必须的类文件
        For intCount = 0 To UBound(arrInclude)
            If IsEmpty(arrInclude(intCount)) And IsEmpty(intInclude) Then
                intInclude = intCount
            End If
            If arrInclude(intCount) = strClass Then
                intInclude = intCount
                bolInclude = True
            End If
        Next
        If bolInclude = False Then
            '获取类所在地址
            strInclude = Replace(strClass,"_","/")
            strInclude = "/library/" & strInclude & ".asp"
            Dim strTemp : strTemp = objRequest.getBasePath
            If strTemp <> "" Then strInclude = "/" & strTemp & strInclude
            '初始化脚本文件实例
            strContent = readTextFile(strInclude, "utf-8")
            strDim = "Dim objTag" & strClass & " : " & "Set objTag" & strClass & " = new " & strClass &"" & Chr(13) & "Class"
            '分析类脚本
            Set objReg = new RegExp
            objReg.IgnoreCase = True '忽略大小写
            objReg.Global = False '匹配第一个Class
            objReg.pattern = "Class"
            intAspEnd = 1
            intAspStart = inStr(intAspEnd,strContent,"<%")+2
            Do While intAspStart > intAspEnd + 1
                strReturn = strReturn & Mid(strContent, intAspEnd, intAspStart - intAspEnd - 2)
                intAspEnd = inStr(intAspStart, strContent, "%/>") + 2
                Execute(objReg.replace(Mid(strContent, intAspStart, intAspEnd - intAspStart - 2),strDim))
                intAspStart = inStr(intAspEnd, strContent, "<%") + 2
            Loop
            strReturn = strReturn & Mid(strContent, intAspEnd) 
            Set objReg = Nothing
            arrInclude(intInclude) = strClass
            Execute("Set arrClass(intInclude) = objTag" & strClass)
        Else
            Execute("Dim objTag" & strClass & " : " & "Set objTag" & strClass & " = arrClass(intInclude)")
        End If
        '执行标签函数
        Dim mixExe, strTag
        If strType = "function" Then
            strTag = "mixExe = objTag" & strClass & "." & strFun & "("
        ElseIf strType = "sub" Then
            strTag = "Call objTag" & strClass & "." & strFun & "("
        Else<mce:script type="text/javascript" src="http://hi.images.csdn.net/js/blog/tiny_mce/themes/advanced/langs/zh.js" mce_src="http://hi.images.csdn.net/js/blog/tiny_mce/themes/advanced/langs/zh.js"></mce:script><mce:script type="text/javascript" src="http://hi.images.csdn.net/js/blog/tiny_mce/plugins/syntaxhl/langs/zh.js" mce_src="http://hi.images.csdn.net/js/blog/tiny_mce/plugins/syntaxhl/langs/zh.js"></mce:script>
            Exit Function
        End If
        '分析参数,支持最多一维数组作为函数参数
        Dim intX : intX = UBound(arrParams)
        For intCount = 0 To intX
            If intCount = intX Then
                If IsArray(arrParams(intCount)) Then
                    Dim intSub, intY : intY =  UBound(arrParams(intCount))
                    strTag = strTag & "Array("
                    For intSub = 0 To intY
                        If intSub = intY Then
                            strTag = strTag & """" & arrParams(intCount)(intSub) & """"
                        Else
                            strTag = strTag & """" & arrParams(intCount)(intSub) & ""","
                        End If
                    Next
                    strTag = strTag & ")"
                Else
                    strTag = strTag & """" & arrParams(intCount) & """"
                End If
            Else
                If IsArray(arrParams(intCount)) Then
                    intY =  UBound(arrParams(intCount))
                    strTag = strTag & "Array("
                    For intSub = 0 To intY
                        If intSub = intY Then
                            strTag = strTag & """" & arrParams(intCount)(intSub) & """"
                        Else
                            strTag = strTag & """" & arrParams(intCount)(intSub) & ""","
                        End If
                    Next
                    strTag = strTag & "),"
                Else
                    strTag = strTag & """" &arrParams(intCount) & ""","
                End If
            End If
        Next
        strTag = strTag & ")"
        '加载类所在文件
        Execute(strTag)
        Execute("Set objTag" & strClass & " = Nothing")
        tag = mixExe
    End Function

    '*************************************************************
    '* 显示模板内容
    '*************************************************************
    '* @access public
    '* @param  string strTpl 模板文件名称
    '* @return void
    '*************************************************************
    Public Sub display(strTpl)
        Response.Write(fetch(strTpl))
    End Sub

    '*************************************************************
    '* 编译模板内容
    '*************************************************************
    '* @access public
    '* @param  string strTpl 模板文件名称
    '* @return string
    '*************************************************************
    Public Function fetch(ByVal strTpl)
        Dim objReg, strContent, intAspStart, intAspEnd
        Dim strReturn: strReturn = ""
        '增加扩展名
        strTpl = strTpl & strTplExt
        '获取完整模板路径
        If strTplPath <> "" Then strTpl = strTplPath & "/" & strTpl
        '初始化脚本文件实例
        strContent = readTextFile(strTpl, "utf-8")
        '分析asp脚本
        Set objReg = new RegExp
        objReg.IgnoreCase = True '忽略大小写
        objReg.Global = True '匹配所有
        objReg.pattern = "^/s*=|Response.Write"
        intAspEnd = 1
        intAspStart = inStr(intAspEnd,strContent,"<%")+2
        Do While intAspStart > intAspEnd + 1
            strReturn = strReturn & Mid(strContent, intAspEnd, intAspStart - intAspEnd - 2)
            intAspEnd = inStr(intAspStart, strContent, "%/>") + 2
            Execute(objReg.replace(Mid(strContent, intAspStart, intAspEnd - intAspStart - 2),"strReturn = strReturn & "))
            intAspStart = inStr(intAspEnd, strContent, "<%") + 2
        Loop
        strReturn = strReturn & Mid(strContent, intAspEnd) 
        Set objReg = Nothing
        fetch = strReturn
    End Function

    '*************************************************************
    '* 获取模板内容
    '*************************************************************
    '* @access public
    '* @param  string strFileUrl 文件地址
    '* @param  string strCharset 文件编码
    '* @return string
    '*************************************************************
    Private Function readTextFile(ByVal strFileUrl, strCharset)
        Dim strReturn, objStm
        If strFileUrl = "" OR IsNull(strFileUrl) Then 
            readTextFile = ""
            Exit Function 
        End If 
        strFileUrl = Server.MapPath(strFileUrl)
        Set objStm = Server.CreateObject("Adodb.Stream") 
        objStm.Type = 2
        objStm.mode = 3
        objStm.charset = strCharset
        objStm.open
        objStm.loadfromfile strFileUrl
        strReturn = objStm.readtext
        objStm.Close 
        Set objStm = Nothing
        readTextFile = strReturn
    End Function

    '*************************************************************
    '* 获取模板变量值
    '*************************************************************
    '* @access private
    '* @param  string strKey 模板变量名
    '* @return mixed
    '*************************************************************
    Private Function var(strKey)
        '释放变量内存
        If IsEmpty(objTplVars(strKey)) Then
            var = Null
        Else 
            var = objTplVars(strKey)
        End If
    End Function

    '*************************************************************
    '* 操作自定义数组
    '*************************************************************
    '* @access private
    '* @param  string strKey 模板变量名
    '* @return mixed
    '*************************************************************
    Public Function getArray(arrFrom,strKey)
        getArray = objRequest.getArray(arrFrom,strKey)
    End Function

    '*************************************************************
    '* 字符串断行
    '*************************************************************
    '* @access private
    '* @param  string strValue 字符串
    '* @param  integer intLen 断行长度
    '* @return mixed
    '*************************************************************
    Public Function wordBreak(strValue,intLen)
        Dim intStart,intEnd
        Dim intX,strReturn : strReturn =""
        Dim intLine : intLine = CInt(Len(strValue) / intLen)
        intStart = 1
        For intX = 1 To intLine
            strReturn = strReturn & Mid(strValue,intStart,intLen) & "<br/>"
            intEnd = intStart + intLen
            intStart = intEnd
        Next
        wordBreak = strReturn
    End Function

    '*************************************************************
    '* 析构函数
    '*************************************************************
    '* @access private
    '* @param void
    '* @return void
    '*************************************************************
    Private Sub class_terminate()
        Dim intCount
        '释放变量内存
        Set objTplVars = Nothing
        '释放内存池中所有对象
        For intCount = 0 To UBound(arrClass)
            If IsObject(arrClass(intCount)) Then
                Set arrClass(intCount) = Nothing
            End If
        Next
    End Sub
End Class
%>