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 [email protected]
'*************************************************************
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
%>