ASP advanced template engine implementation class

CopyCode The 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 the template folder path
'***************************************
Public property let path (byval Str)
C_path = Str
End Property
Public property get path
Path = c_path
End Property

'***************************************
'Set the template file name
'***************************************
Public property let filename (byval Str)
C_filename = Str
End Property
Public property get filename
Filename = c_filename
End Property

'***************************************
'Obtain 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 pagination URL
'***************************************
Public property let pageurl (byval Str)
C_pageurl = Str
End Property
Public property get pageurl
Pageurl = c_pageurl
End Property

'***************************************
'Sets the current page of pagination.
'***************************************
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

'***************************************
'File Loading 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
Set OBJ = nothing
End Function

'*************************************** ********
'Get the regular expression 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
Set Reg = nothing
End Function

'***************************************
'Open the document
'***************************************
Public sub open
C_content = loadfromfile (filepath)
End sub

'***************************************
'Buffer 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] + ?) <\/"& 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) 'returns the results after all processes are executed.
O_content = Replace (o_content, submatches. value, "<" & subtext (2) & subtext (0) & ">" & subtext (1) & "</" & subtext (2) & "> ", 1,-1, 1) 'Replace the tag variable
Next
End if
Set matches = nothing
If Len (replacepagestr (0)> 0 then', determine whether the label variable has a value. If yes, replace it.
O_content = Replace (o_content, replacepagestr (0), replacepagestr (1), 1,-1, 1)
Replacepagestr = array ("", "") ', replace it, and clear the array variable.
End if
Gridview = o_content
End Function

'***************************************
'Confirm the property
'***************************************
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 the 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 the 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 )'
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

'***************************************
'Resolution
'***************************************
Private function analysis (byval ID, byval name, byval content, byval page, byval pageid)
Dim data
Select case lcase (name) 'select a 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 the data source
'***************************************
Private function databind (byval ID, byval content, byval page, byval pageid)
Dim text, matches, submatches, subtext
Execute "text =" & ID & "(1)" 'load the data source
Set matches = getmatch (content, "\ <columns \> ([\ s] +) \ <\/columns \> ")
If matches. Count> 0 then
For each submatches in matches
Subtext = itemtemplate (submatches. submatches (0), text, page, pageid) 'replacement of the execution module
Content = Replace (content, submatches. Value, subtext, 1,-1, 1)
Next
Databind = content
Else
Databind = ""
End if
Set matches = nothing
End Function

'***************************************
'Matching 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] +) \ <\/itemtemplate \> ")
If matches. Count> 0 then
For each submatches in matches
Submatchtext = submatches. submatches (0)
'---------------------------------------------
'Start with loop nesting
'---------------------------------------------
Submatchtext = gridview (submatchtext)
'---------------------------------------------
'Loop nesting ends
'---------------------------------------------
If ubound (text, 1) = 0 then
Temptext = ""
Else
Temptext = ""
'-----------------------------------------------
'Start pagination
'-----------------------------------------------
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) 'execute 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, "\ ")
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

'***************************************
'General replacement of global tags
'***************************************
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