This template engine is more convenient. It is combined with HTML. The copy code is as follows:
Class template
Private c_Char, c_Path, c_FileName, c_Content, c_PageUrl, c_CurrentPage, c_PageStr, ReplacePageStr
Private TagName
' ***************************************
'Set encoding
' ***************************************
Public Property Let Char(ByVal Str)
c_Char = Str
End Property
Public Property Get Char
Char = c_Char
End Property
' ***************************************
'Set template folder path
' ***************************************
Public Property Let Path(ByVal Str)
c_Path = Str
End Property
Public Property Get Path
Path = c_Path
End Property
' ***************************************
'Set template file name
' ***************************************
Public Property Let FileName(ByVal Str)
c_FileName = Str
End Property
Public Property Get FileName
FileName = c_FileName
End Property
' ***************************************
' Get the specific path of the template file
' ***************************************
Public Property Get FilePath
If Len(Path) > 0 Then Path = Replace(Path, /, /)
If Right(Path, 1) <> / Then Path = Path & /
FilePath = Path & FileName
End Property
' ***************************************
'Set paging URL
' ***************************************
Public Property Let PageUrl(ByVal Str)
c_PageUrl = Str
End Property
Public Property Get PageUrl
PageUrl = c_PageUrl
End Property
' ***************************************
'Set paging current page
' ***************************************
Public Property Let CurrentPage(ByVal Str)
c_CurrentPage = Str
End Property
Public Property Get CurrentPage
CurrentPage = c_CurrentPage
End Property
' ***************************************
'Output content
' ***************************************
Public Property Get Flush
Response.Write(c_Content)
End Property
' ***************************************
'Class initialization
' ***************************************
Private Sub Class_Initialize
TagName = pjblog
c_Char = UTF-8
ReplacePageStr = Array(, )
End Sub
' ***************************************
' Filter conflicting characters
' ***************************************
Private Function doQuote(ByVal Str)
doQuote = Replace(Str, Chr(34), )
End Function
' ***************************************
' Class termination
' ***************************************
Private Sub Class_Terminate
End Sub
' ***************************************
'Load file method
' ***************************************
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
'**********************************************
' Get the regular matching object
'**********************************************
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
' ***************************************
'Open document
' ***************************************
Public Sub open
c_Content = LoadFromFile(FilePath)
End Sub
' ***************************************
'Buffered execution
' ***************************************
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) 'Return the results of all process executions
o_Content = Replace(o_Content, SubMatches.value, < & SubText(2) & SubText(0) & > & SubText(1) & </ & SubText(2) & >, 1, -1, 1) ' Replace label variable
Next
End If
Set Matches = Nothing
If Len(ReplacePageStr(0)) > 0 Then ' Determine whether the label variable has a value, and replace it if so.
o_Content = Replace(o_Content, ReplacePageStr(0), ReplacePageStr(1), 1, -1, 1)
ReplacePageStr = Array(, ) 'Clear the array variable after replacement
End If
GridView = o_Content
End Function
' ***************************************
' Determine attributes
' ***************************************
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) ' Get the attribute name
MatchContent = SubMatches.SubMatches(1) ' Get attribute value
If Lcase(MatchTag) = name Then Name = MatchContent ' Get the name attribute value
If Lcase(MatchTag) = datasource Then datasource = MatchContent' Get the datasource attribute value
If Lcase(MatchTag) = element Then Element = MatchContent ' Get element attribute value
If Lcase(MatchTag) = page Then page = MatchContent ' Get the page attribute value
If Lcase(MatchTag) = id Then id = MatchContent ' Get the id attribute value
Next
If Len(Name) > 0 And Len(MatchContent) > 0 Then
Text = Analysis(datasource, Name, Content, page, id) 'Perform parsing properties
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
' ***************************************
' Parse
' ***************************************
Private Function Analysis(ByVal id, ByVal Name, ByVal Content, ByVal page, ByVal PageID)
Dim Data
Select Case Lcase(Name) 'Select data source
Case loop Data = DataBind(id, Content, page, PageID)
Case for Data = DataFor(id, Content, page, PageID)
End Select
Analysis=Data
End Function
' ***************************************
'Bind data source
' ***************************************
Private Function DataBind(ByVal id, ByVal Content, ByVal page, ByVal PageID)
Dim Text, Matches, SubMatches, SubText
Execute Text = & id & (1) 'Load data source
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)' Perform module replacement
Content = Replace(Content, SubMatches.value, SubText, 1, -1, 1)
Next
DataBind = Content
Else
DataBind=
End If
Set Matches = Nothing
End Function
' ***************************************
' Match template instance
' ***************************************
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)
'------------------------------------------------
' Start loop nesting
'------------------------------------------------
SubMatchText = GridView(SubMatchText)
'------------------------------------------------
' End of loop nesting
'---------------------------------------------
If UBound(Text, 1) = 0 Then
TempText =
Else
TempText=
'-------------------------------------------------
'Start paging
'-------------------------------------------------
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) 'Load template content
Next
End If
Next
ItemTemplate = TempText
Else
ItemTemplate =
End If
Set Matches = Nothing
End Function
' ***************************************
'Replace template string
' ***************************************
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) 'Perform replacement
Next
ItemReSec = Text
Else
ItemReSec=
End If
Set Matches = Nothing
End Function
' ***************************************
'Global variable 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
' ***************************************
' Ordinary replacement of global labels
' ***************************************
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