Class template

    Private c_Char, c_Path, c_FileName, c_Content, c_PageUrl, c_CurrentPage, c_PageStr, ReplacePageStr
    Private TagName

    ' ***************************************
    '    設置編碼
    ' ***************************************
    Public Property Let Char(ByVal Str)
        c_Char = Str
    End Property
    Public Property Get Char
        Char = c_Char
    End Property

    ' ***************************************
    '    設置模板文件夾路徑
    ' ***************************************
    Public Property Let Path(ByVal Str)
        c_Path = Str
    End Property
    Public Property Get Path
        Path = c_Path
    End Property

    ' ***************************************
    '    設置模板文件名
    ' ***************************************
    Public Property Let FileName(ByVal Str)
        c_FileName = Str
    End Property
    Public Property Get FileName
        FileName = c_FileName
    End Property

    ' ***************************************
    '    獲得模板文件具體路徑
    ' ***************************************
    Public Property Get FilePath
        If Len(Path) > 0 Then Path = Replace(Path, "\", "/")
        If Right(Path, 1) > "/" Then Path = Path "/"
        FilePath = Path FileName
    End Property

    ' ***************************************
    '    設置分頁URL
    ' ***************************************
    Public Property Let PageUrl(ByVal Str)
        c_PageUrl = Str
    End Property
    Public Property Get PageUrl
        PageUrl = c_PageUrl
    End Property

    ' ***************************************
    '    設置分頁 當前頁
    ' ***************************************
    Public Property Let CurrentPage(ByVal Str)
        c_CurrentPage = Str
    End Property
    Public Property Get CurrentPage
        CurrentPage = c_CurrentPage
    End Property

    ' ***************************************
    '    輸出內容
    ' ***************************************
    Public Property Get Flush
        Response.Write(c_Content)
    End Property

    ' ***************************************
    '    類初始化
    ' ***************************************
    Private Sub Class_Initialize
        TagName = "pjblog"
        c_Char = "UTF-8"
        ReplacePageStr = Array("", "")
    End Sub

    ' ***************************************
    '    過濾沖突字符
    ' ***************************************
    Private Function doQuote(ByVal Str)
        doQuote = Replace(Str, Chr(34), """)
    End Function

    ' ***************************************
    '    類終結
    ' ***************************************
    Private Sub Class_Terminate
    End Sub

    ' ***************************************
    '    加載文件方法
    ' ***************************************
    Private Function LoadFromFile(ByVal cPath)
        Dim obj
        Set obj = Server.CreateObject("ADODB.Stream")
            With obj
             .Type = 2
                .Mode = 3
                .Open
                .Charset = Char
                .Position = .Size
                .LoadFromFile Server.MapPath(cPath)
                LoadFromFile = .ReadText
                .close
            End With
        Set obj = Nothing
    End Function

    ' ***********************************************
    '    獲取正則匹配對象
    ' ***********************************************
    Public Function GetMatch(ByVal Str, ByVal Rex)
        Dim Reg, Mag
        Set Reg = New RegExp
        With Reg
            .IgnoreCase = True
            .Global = True
            .Pattern = Rex
            Set Mag = .Execute(Str)
            If Mag.Count > 0 Then
                Set GetMatch = Mag
            Else
                Set GetMatch = Server.CreateObject("Scripting.Dictionary")
            End If
        End With
        Set Reg = nothing
    End Function

    ' ***************************************
    '    打開文檔
    ' ***************************************
    Public Sub open
        c_Content = LoadFromFile(FilePath)
    End Sub

    ' ***************************************
    '    緩沖執行
    ' ***************************************
    Public Sub Buffer
        c_Content = GridView(c_Content)
        Call ExecuteFunction
    End Sub

    ' ***************************************
    '    GridView
    ' ***************************************
    Private Function GridView(ByVal o_Content)
        Dim Matches, SubMatches, SubText
        Dim Attribute, Content
        Set Matches = GetMatch(o_Content, "\" TagName "\:(\d+?)(.+?)\&;([\s\S]+?)\/" TagName "\:\1\&;")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                Attribute = SubMatches.SubMatches(1)     ' kocms
                Content = SubMatches.SubMatches(2)     ' Columns>.../Columns>
                SubText = Process(Attribute, Content)     ' 返回所有過程執行后的結果
                o_Content = Replace(o_Content, SubMatches.value, "" SubText(2) SubText(0) ">" SubText(1) "/" SubText(2) ">", 1, -1, 1)                                            ' 替換標簽變量
            Next
        End If
        Set Matches = Nothing
        If Len(ReplacePageStr(0)) > 0 Then                ' 判斷是否標簽變量有值,如果有就替換掉.
            o_Content = Replace(o_Content, ReplacePageStr(0), ReplacePageStr(1), 1, -1, 1)
            ReplacePageStr = Array("", "")                ' 替換后清空該數組變量
        End If
        GridView = o_Content
    End Function

    ' ***************************************
    '    確定屬性
    ' ***************************************
    Private Function Process(ByVal Attribute, ByVal Content)
        Dim Matches, SubMatches, Text
        Dim MatchTag, MatchContent
        Dim datasource, Name, Element, page, id
        datasource = "" : Name = "" : Element = "" : page = 0 : id = ""
        Set Matches = GetMatch(Attribute, "\s(.+?)\=\""(.+?)\""")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                MatchTag = SubMatches.SubMatches(0)                                ' 取得屬性名
                MatchContent = SubMatches.SubMatches(1)                            ' 取得屬性值
                If Lcase(MatchTag) = "name" Then Name = MatchContent            ' 取得name屬性值
                If Lcase(MatchTag) = "datasource" Then datasource = MatchContent' 取得datasource屬性值
                If Lcase(MatchTag) = "element" Then Element = MatchContent        ' 取得element屬性值
                If Lcase(MatchTag) = "page" Then page = MatchContent            ' 取得page屬性值
                If Lcase(MatchTag) = "id" Then id = MatchContent                ' 取得id屬性值
            Next
            If Len(Name) > 0 And Len(MatchContent) > 0 Then
                Text = Analysis(datasource, Name, Content, page, id)            ' 執行解析屬性
                If Len(datasource) > 0 Then Attribute = Replace(Attribute, "datasource=""" datasource """", "")
                If page > 0 Then Attribute = Replace(Attribute, "page=""" page """", "")
                Attribute = Replace(Attribute, "name=""" Name """", "", 1, -1, 1)
                Attribute = Replace(Attribute, "element=""" Element """", "", 1, -1, 1)
                Process = Array(Attribute, Text, Element)
            Else
                Process = Array(Attribute, "", "div")
            End If
        Else
            Process = Array(Attribute, "", "div")
        End If
        Set Matches = Nothing
    End Function

    ' ***************************************
    '    解析
    ' ***************************************
    Private Function Analysis(ByVal id, ByVal Name, ByVal Content, ByVal page, ByVal PageID)
        Dim Data
        Select Case Lcase(Name)                                                    ' 選擇數據源
            Case "loop" Data = DataBind(id, Content, page, PageID)
            Case "for" Data = DataFor(id, Content, page, PageID)
        End Select
        Analysis = Data
    End Function

    ' ***************************************
    '    綁定數據源
    ' ***************************************
    Private Function DataBind(ByVal id, ByVal Content, ByVal page, ByVal PageID)
        Dim Text, Matches, SubMatches, SubText
        Execute "Text = " id "(1)"                                            ' 加載數據源
        Set Matches = GetMatch(Content, "\Columns\&;([\s\S]+)\\/Columns\&;")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                SubText = ItemTemplate(SubMatches.SubMatches(0), Text, page, PageID)' 執行模塊替換
                Content = Replace(Content, SubMatches.value, SubText, 1, -1, 1)
            Next
            DataBind = Content
        Else
            DataBind = ""
        End If
        Set Matches = Nothing
    End Function

    ' ***************************************
    '    匹配模板實例
    ' ***************************************
    Private Function ItemTemplate(ByVal TextTag, ByVal Text, ByVal page, ByVal PageID)
        Dim Matches, SubMatches, SubMatchText
        Dim SecMatch, SecSubMatch
        Dim i, TempText
        Dim TextLen, TextLeft, TextRight
        Set Matches = GetMatch(TextTag, "\ItemTemplate\&;([\s\S]+)\\/ItemTemplate\&;")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                SubMatchText = SubMatches.SubMatches(0)
                ' ---------------------------------------------
                '    循環嵌套開始
                ' ---------------------------------------------
                SubMatchText = GridView(SubMatchText)
                ' ---------------------------------------------
                '    循環嵌套結束
                ' ---------------------------------------------
                If UBound(Text, 1) = 0 Then
                    TempText = ""
                Else
                    TempText = ""
                    ' -----------------------------------------------
                    '    開始分頁
                    ' -----------------------------------------------
                    If Len(page) > 0 And page > 0 Then
                        If Len(CurrentPage) = 0 Or CurrentPage = 0 Then CurrentPage = 1
                        TextLen = UBound(Text, 2)
                        TextLeft = (CurrentPage - 1) * page
                        TextRight = CurrentPage * page - 1
                        If TextLeft 0 Then TextLeft = 0
                        If TextRight > TextLen Then TextRight = TextLen
                        c_PageStr = MultiPage(TextLen + 1, page, CurrentPage, PageUrl, "float:right", "", False)

                        If Int(Len(c_PageStr)) > 0 Then
                            ReplacePageStr = Array("page:" Trim(PageID) "/>", c_PageStr)
                        Else
                            ReplacePageStr = Array("page:" Trim(PageID) "/>", "")
                        End If
                    Else
                        TextLeft = 0
                        TextRight = UBound(Text, 2)
                    End If

                    For i = TextLeft To TextRight
                        TempText = TempText ItemReSec(i, SubMatchText, Text)        ' 加載模板內容
                    Next
                End If
            Next
            ItemTemplate = TempText
        Else
            ItemTemplate = ""
        End If
        Set Matches = Nothing
    End Function

    ' ***************************************
    '    替換模板字符串
    ' ***************************************
    Private Function ItemReSec(ByVal i, ByVal Text, ByVal Arrays)
        Dim Matches, SubMatches
        Set Matches = GetMatch(Text, "\$(\d+?)")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                Text = Replace(Text, SubMatches.value, doQuote(Arrays(SubMatches.SubMatches(0), i)), 1, -1, 1) '執行替換
            Next
            ItemReSec = Text
        Else
            ItemReSec = ""
        End If
        Set Matches = Nothing
    End Function

    ' ***************************************
    '    全局變量函數
    ' ***************************************
    Private Sub ExecuteFunction
        Dim Matches, SubMatches, Text, ExeText
        Set Matches = GetMatch(c_Content, "\function\:([0-9a-zA-Z_\.]*?)\((.*?)\""(.+?)\""(.*?)\)\/\&;")
        If Matches.Count > 0 Then
            For Each SubMatches In Matches
                Text = SubMatches.SubMatches(0) "(" SubMatches.SubMatches(1) """" SubMatches.SubMatches(2) """" SubMatches.SubMatches(3) ")"
                Execute "ExeText=" Text
                c_Content = Replace(c_Content, SubMatches.value, ExeText, 1, -1, 1)
            Next
        End If
        Set Matches = Nothing
    End Sub

    ' ***************************************
    '    普通替換全局標簽
    ' ***************************************
    Public Property Let Sets(ByVal t, ByVal s)
        Dim SetMatch, Bstr, SetSubMatch
        Set SetMatch = GetMatch(c_Content, "(\Set\:([0-9a-zA-Z_\.]*?)\(((.*?)" t "(.*?))?\)\/\&;)")
        If SetMatch.Count > 0 Then
            For Each SetSubMatch In SetMatch
                Execute "Bstr = " SetSubMatch.SubMatches(1) "(" SetSubMatch.SubMatches(3) """" s """" SetSubMatch.SubMatches(4) ")"
                c_Content = Replace(c_Content, SetSubMatch.Value, Bstr, 1, -1, 1)
            Next
        End If
        Set SetMatch = Nothing
        Set SetMatch = GetMatch(c_Content, "(\Set\:" t "\/\&;)")
        If SetMatch.Count > 0 Then
            For Each SetSubMatch In SetMatch
                c_Content = Replace(c_Content, SetSubMatch.Value, s, 1, -1, 1)
            Next
        End If
        Set SetMatch = Nothing
    End Property

End Class