MVC 模式在网站架构中十分常见。它允许我们建立一个三层结构的应用程式,从代码中分离出有用的层,帮助设计师和开发者协同工作以及提高我们维护和扩展既有程式的能力。 PHP 中有一个很著名的类库 phpLib,其中有 Template 模板类。能够很方便地实现代码分离。在 asp 中是否也可以这样做呢?至少以前没有出现过,几乎所有的asp程序都是和html等代码放在同一个文件,既不容易管理,也不方便维护和扩展。 这就是 aspTemplate 的初衷。它完全实现了 phpLib Template 的全部功能,你可以象使用 phpLib Template 一样使用它,连习惯也基本不用改。现在支持调用文件与数据库模板两种模式(其中文件模板需要FSO权限) :)
<!-- METADATA TYPE="typelib" UUID="00000200-0000-0010-8000-00AA006D2EA4" NAME="ADO Type Library" -->
<%
'####################################################################### '## NAME: aspTemplate '## BY: BigHan '## DATE: Nov. 28, 2003 '## SITE: http://www.isbyte.com/ '## EMAIL: aspTemplate@21cn.com '## '## (C) Copyright 2003-2004 bighan '#######################################################################
'####################################################################### '## Database Table: See db/aspTemplate.mdb '#######################################################################
Class aspTemplate
'#### '## name of this class '## var string '## @access Private '## @see property: Name '#### Private m_strName
'#### '## version of this class '## var string '## @access Private '## @see property: Version '#### Private m_strVersion
'#### '## Determines how much debugging output Template will produce. '## This is a bitwise mask of available debug levels: '## 0 = no debugging '## 1 = debug variable assignments '## 2 = debug calls to get variable '## 3 = debug SQL '## 4 = debug internals (outputs all function calls with parameters). '## '## @var int '## @access Private '## @see property: Debug '#### Private m_intDebug
'#### '## Template files data type '## '## "db" = Database '## "file" = File '## '## @var string '## @access private '## @see property: Mode '#### Private m_strMode
'#### '## The base directory from which template files are loaded. '## '## @var string '## @access private '## @see property: Root, Dir; method: SetRoot, set_root '#### Private m_Root
'#### '## Determines how to output variable tags with no assigned value in templates. '## '## @var string '## @access private '## @see property Unknowns; method: SetUnknowns, set_unknowns '#### Private m_strUnknowns
'#### '## Determines how Template handles error conditions. '## "yes" = the error is reported, then execution is halted '## "report" = the error is reported, then execution continues by returning "false" '## "no" = errors are silently ignored, and execution resumes reporting "false" '## '## @var string '## @access private '## @see property IsHalt; method: halt '#### Private m_strHaltError
'#### '## The last error message is retained in this variable. '## '## @var string '## @access private '## @see property LastError '## Private m_strLastError
'#### '## Opening delimiter (usually "{") '## '## @var string '## @access private '## @see property BeginTag '#### Private m_strBeginTag
'#### '## Closing delimiter (usually "}") '## '## @var string '## @access private '## @see private EndTag '#### Private m_strEndTag
'#### '## A hash of strings forming a translation table which translates variable names '## into names of files containing the variable content. '## m_oFile.Item(varname) = "filename"; '## '## @var object '## @access private '## @see method: SetFile, SetFiles, set_file '#### Private m_oFile
'#### '## Regular Exdivssion Object '## '## @var object '## @access private '#### Private m_oRegExp
'#### '## A hash of strings forming a translation table which translates variable names '## into regular exdivssions for themselves. '## m_oVarKeys.Item(varname) = "{varname}" '## '## @var object '## @access private '## @see method: SetVar, SetVars, SetAppendVar, SetAppendVars, set_var '#### Private m_oVarKeys
'#### '## A hash of strings forming a translation table which translates variable names '## into values for their respective varkeys. '## m_oVarVals.Item(varname) = "value" '## '## @var object '## @access private '## @see method: SetVar, SetVars, SetAppendVar, SetAppendVars, set_var '#### Private m_oVarVals
'#### '## Connection Object, if this Mode = "db" the Connection Object need. '## '## @var object '## @access private '## @see property: ActiveConnection, method: OpenTemplateDatabase, CloseTemplateDatabase '#### Private m_oConn
'#### '## Is native connection object. '## '## @var object '## @access private '## @see property: ActiveConnection, method: OpenTemplateDatabase, CloseTemplateDatabase '#### Private m_blnNativeConnection
'#### '## Is Open connection object. '## '## @var object '## @access private '## @see property: ActiveConnection, method: OpenTemplateDatabase, CloseTemplateDatabase '#### Private m_blnConnectionState
'#### '## Template database set table name. '## '## @var string '## @access private '## @see property: CatTable '#### Private m_strCatTable
'#### '## Template database data table name. '## '## @var string '## @access private '## @see property: DataTable '#### Private m_strDataTable
'#### '## get class name attribute. '## '## usage: oTemplate.Name '## access public '##
Public Property Get Name() '############################################################ Name = m_strName End Property
'#### '## get class version property. '## '## usage: oTemplate.Version '## access public '## Public Property Get Version() '############################################################ Version = m_strVersion End Property
'#### '## get/set m_strMode property. '## '## usage: oTemplate.Mode = string A_strType '## access public '## Public Property Let Mode(ByVal A_strType) '############################################################ If Debug = 4 Then Response.Write "<p><b>Mode:</b> A_strType = " & A_strType & "</p>" & VbCrLf A_strType = LCase(A_strType) Select Case A_strType Case "file" m_strMode = "file" Case "db" m_strMode = "db" End Select End Property
Public Property Get Mode() Mode = m_strMode End Property
'#### '## set m_oConn property. '## '## usage: oTemplate.ActiveConnection = object A_oConn '## access public '## Public Property Let ActiveConnection(ByRef A_oConn) '############################################################ If Debug = 3 Then Response.Write "<p><b>ActiveConnection:</b> Use ActiveConnection</p>" & VbCrLf if IsObject(A_oConn) Then If A_oConn.State <> AdStateClosed Then Set m_oConn = A_oConn m_blnConnectionState = True m_blnNativeConnection = False End If End If End Property
'#### '## set/get m_strCatTable property. '## '## usage: oTemplate.CatTable = string A_strCatTable '## access public '## Public Property Let CatTable(ByVal A_strCatTable) '############################################################ If Debug = 3 Then Response.Write "<p><b>CatTable:</b> A_strCatTable = " & A_strCatTable & "</p>" & VbCrLf m_strCatTable = A_strCatTable End Property
Public Property Get CatTable() CatTable = m_strCatTable End Property
'#### '## set/get m_strDataTable property. '## '## usage: oTemplate.DataTable = string A_strDataTable '## access public '## Public Property Let DataTable(ByVal A_strDataTable) '############################################################ If Debug = 3 Then Response.Write "<p><b>DataTable:</b> A_strDataTable = " & A_strDataTable & "</p>" & VbCrLf m_strDataTable = A_strDataTable End Property
Public Property Get DataTable() DataTable = m_strDataTable End Property
'#### '## get/set m_intDebug attribute. '## '## usage: oTemplate.Debug = int A_intDebug '## access public '## Public Property Let Debug(ByVal A_intDebug) '############################################################ m_intDebug = CInt(A_intDebug) End Property
Public Property Get Debug() Debug = m_intDebug End Property
'#### '## Sets the policy for dealing with unresolved variable names. '## '## unknowns defines what to do with undefined template variables '## "remove" = remove undefined variables '## "comment" = replace undefined variables with comments '## "keep" = keep undefined variables '## '## Note: "comment" can cause unexpected results when the variable tag is embedded '## inside an HTML tag, for example a tag which is expected to be replaced with a URL. '## '## usage: oTemplate.Unknowns = string A_strUnknowns '## '## @param A_strUnknowns new value for unknowns '## @see unknowns, SetUnknowns, set_unknowns '## @access public '## Public Property Let Unknowns(ByVal A_strUnknowns) '############################################################ If Debug = 4 Then Response.Write "<p><b>Unknowns:</b> unknowns = " & A_strUnknowns & "</p>" & VbCrLf A_strUnknowns = LCase(A_strUnknowns) Select Case A_strUnknowns Case "keep" m_strUnknowns = "keep" Case "remove" m_strUnknowns = "remove" Case "comment" m_strUnknowns = "comment" Case Else m_strUnknowns = "remove" End Select End Property
Public Property Get Unknowns() Unknowns = m_strUnknowns End Property
'#### '## Checks that root is a valid directory and if so sets this directory as the '## base directory from which templates are loaded by storing the value in '## Root. Relative filenames are divpended with the path in Root. '## '## usage: oTemplate.Root = string A_strDir '## '## @param A_root string containing new template directory '## @see m_Root, SetRoot, set_root '## @access public '## Public Property Let Root(ByVal A_strDir) '############################################################ Dim MM_FSO, sql, rs, MM_TempDir, num If Debug = 4 Then Response.Write "<p><b>Root:</b> root = " & A_strDir & "</p>" & VbCrLf If Len(A_strDir) > 0 Then If Mode = "file" Then Set MM_FSO = CreateObject("Scripting.FileSystemObject") If MM_FSO.FolderExists(Server.MapPath(A_strDir)) Then If Right(A_strDir, 1) <> "/" Then m_Root = A_strDir & "/" Else m_Root = A_strDir End If Else Call halt("The folder " & A_strDir & " does not exist.") End If ElseIf Mode = "db" Then If Right(A_strDir, 1) = "/" Then A_strDir = left(A_strDir, len(A_strDir) -1) If left(A_strDir, 1) = "/" Then A_strDir = Right(A_strDir, len(A_strDir) -1) MM_TempDir = Split(A_strDir, "/") num = UBound(MM_TempDir) If num > 0 Then A_strDir = MM_TempDir(num) sql = "SELECT tplcat_id FROM " & CatTable & " WHERE tplcat_name='" & A_strDir &"'" Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sql, m_oConn, AdOpenForwardOnly, AdLockReadOnly, adCmdText If Not rs.EOF Then m_Root = rs("tplcat_id") Else Call halt("Not Find template category " & A_strDir & " from database.") End If Set rs = Nothing If Debug = 3 Then Response.Write "<p><b>Root:</b> sql = " & sql & "</p>" & VbCrLf End If Else Call halt("The folder Root does not empty.") End If End Property
Public Property Get Root() Root = m_Root End Property
'#### '## '## alias of Root '## Public Property Let Dir(ByVal A_strDir) '############################################################ Root = A_strDir End Property
Public Property Get Dir() Dir = Root End Property
'#### '## Set/Get class m_strHaltError attribute. '## '## "yes" = the error is reported, then execution is halted. '## "no" = errors are silently ignored. '## "report" = the error is reported, then execution continues. '## '## usage: oTemplate.IsHalt = string A_strHalt '## '## @param A_strHalt new value for m_strHaltError '## @see Halt '## @access public '## Public Property Let IsHalt(ByVal A_strHalt) '############################################################ A_strHalt = LCase(A_strHalt) Select Case A_strHalt Case "yes" m_strHaltError = "yes" Case "no" m_strHaltError = "no" Case "report" m_strHaltError = "report" End Select End Property
Public Property Get IsHalt() IsHalt = m_strHaltError End Property
'#### '## Set/Get class m_strBeginTag attribute. '## '## Note: Don't conflict of HTML tag '## '## usage: oTemplate.BeginTag = string A_strTag '## '## @param A_strTag new value for m_strBeginTag '## @access public '## Public Property Let BeginTag(ByVal A_strTag) '############################################################ If Debug = 4 Then Response.Write "<p><b>BeginTag:</b> BeginTag = " & A_strTag & "</p>" & VbCrLf m_strBeginTag = A_strTag End Property
Public Property Get BeginTag() BeginTag = m_strBeginTag End Property
'#### '## Set/Get class m_strEndTag attribute. '## '## Note: Don't conflict of HTML tag '## '## usage: oTemplate.EndTag = string A_strTag '## '## @param A_strTag new value for m_strEndTag '## @access public '## Public Property Let EndTag(ByVal A_strTag) '############################################################ If Debug = 4 Then Response.Write "<p><b>EndTag:</b> EndTag = " & A_strTag & "</p>" & VbCrLf m_strEndTag = A_strTag End Property
Public Property Get EndTag() EndTag = m_strEndTag End Property
'#### '## Get class last error messages. '## '## usage: oTemplate.LastError '## '## @access public '## Public Property Get LastError() '############################################################ LastError = m_strLastError End Property
'#### '## Open template database Connection object. if this Mode="db", need first open. '## '## usage: oTemplate.OpenTemplateDatabase string A_strConnString '## '## @access public '## Public Sub OpenTemplateDatabase(ByVal A_strConnString) '############################################################ on error resume next If Debug = 3 Then Response.Write "<p><b>OpenTemplateDatabase:</b> A_strConnString = " & A_strConnString & "</p>" & VbCrLf if IsNull(m_oConn) Or Not IsObject(m_oConn) Then Set m_oConn = Server.CreateObject("ADODB.Connection") m_oConn.ConnectionString = A_strConnString m_oConn.Open If Err Then err.Clear Set m_oConn = Nothing Call halt("Connection: Open Connection by string " & A_strConnString & " error.") Else m_blnConnectionState = True m_blnNativeConnection = True End If End If End Sub
'#### '## Close template database Connection object. '## '## usage: oTemplate.CloseTemplateDatabase '## '## @access public '## Public Sub CloseTemplateDatabase() '############################################################ if IsObject(m_oConn) Then If Debug = 3 Then Response.Write "<p><b>CloseTemplateDatabase:</b> Close Database ... ...</p>" & VbCrLf If m_blnNativeConnection = True Then m_oConn.Close Set m_oConn = Nothing Else Set m_oConn = Nothing End If End If m_blnConnectionState = False End Sub
'#### '## '## @see Root '## Public Sub SetRoot(ByVal A_strDir) '############################################################ Root = A_strDir End Sub
'## @same phplib::template->set_root Public Sub set_root(ByVal A_strDir) Root = A_strDir End Sub
'#### '## '## @see Unknown '## Public Sub SetUnknowns(ByVal A_strUnknowns) '############################################################ Unknowns = A_strUnknowns End Sub
'## @same phplib::template->set_root Public Sub set_unknowns(ByVal A_strUnknowns) Unknowns = A_strUnknowns End Sub
'#### '## Defines a filename for the initial value of a variable. '## '## It may be passed either a varname and a file name as two strings or '## a hash of strings with the key being the varname and the value '## being the file name. '## '## The new mappings are stored in the object m_oFile. '## The files are not loaded yet, but only when needed. '## '## '## usage: oTemplate.SetFile A_varname, A_filename '## or '## usage: oTemplate.SetFile array(A_varname1, A_filename1 _ '## ,A_varname2, A_filename2 _ '## ,.... .... , ,,,. ,,,, ) _ '## , "" '## @see SetFiles '## @param A_varname either a string containing a varname or a hash of varname/file name pairs. '## @param A_filename if varname is a string this is the filename otherwise filename is not required '## @access public '## Public Sub SetFile(ByVal A_varname, ByVal A_filename) '############################################################ Dim MM_strFiles, num If Not IsArray(A_varname) Then If Debug = 4 Then Response.Write "<p><b>SetFile:</b> (with scalar) varname = "& A_varname &", filename = "& A_filename &"</p>" & VbCrLf If A_filename = "" Then Call halt("SetFile: For varname " & A_filename & " filename is empty.") Exit Sub End If MM_strFiles = filename(A_filename) m_oFile.Add A_varname, MM_strFiles Else Call SetFiles(A_varname) End If End Sub
'#### '## Defines a multi-filename for the initial value of a variable. '## '## usage: oTemplate.SetFiles array(A_varname1, A_filename1 _ '## ,A_varname2, A_filename2 _ '## ,.... .... , ,,,. ,,,, ) '## @param array A_varname '## @access public '## @see SetFile '## Public Sub SetFiles(ByVal A_varname) '############################################################ Dim i, num If IsArray(A_varname) Then num = Ubound(A_varname) if ((num +1) mod 2) <> 0 Then Call halt("SetFiles: For varname array's element not gemination.") Exit Sub Else For i = 0 To num Step 2 Call SetFile(A_varname(i), A_varname(i+1)) Next End If Else Call SetFile(A_varname, "") End If End Sub
'## @same phplib::template->set_file Public Sub set_file(ByVal A_varname, ByVal A_filename) Call SetFile(A_varname, A_filename) End Sub
'#### '## A variable $parent may contain a variable block defined by: '## <!-- BEGIN A_varname --> content <!-- END A_varname -->. This function removes '## that block from $parent and replaces it with a variable reference named $name. '## The block is inserted into the varkeys and varvals hashes. If A_name is '## omitted, it is assumed to be the same as A_varname. '## '## Blocks may be nested but care must be taken to extract the blocks in order '## from the innermost block to the outermost block. '## '## usage: oTemplate.SetBlock string A_parent, string A_parent, string A_name '## '## @param A_parent a string containing the name of the parent variable '## @param A_varname a string containing the name of the block to be extracted '## @param A_name the name of the variable in which to store the block '## @access public '## Public Sub SetBlock(ByVal A_parent, ByVal A_varname, ByVal A_name) '############################################################ Dim MM_String, MM_MatchString If Debug = 4 Then Response.Write "<p><b>SetBlock:</b> parent = " & A_parent & ", varname = " & A_varname & ", name = " & A_name & "</p>" & VbCrLf If Not loadfile(A_parent) Then Call halt("SetBlock: unable to load " & A_parent & ".") Exit Sub End If if A_name = "" Then A_name = A_varname MM_String = GetVar(A_parent) m_oRegExp.IgnoreCase = True m_oRegExp.Global = True m_oRegExp.Pattern = "<!--\s+BEGIN\s+(" & A_varname & ")\s+-->([\s\S.]*)<!--\s+END\s+\1\s+-->" Set Matches = m_oRegExp.Execute(MM_String) For Each Match In Matches MM_MatchString = Match.SubMatches(1) MM_String = m_oRegExp.Replace(MM_String, BeginTag & A_name & EndTag) Call SetVar(A_varname,MM_MatchString) Call SetVar(A_parent,MM_String) Next End Sub
'## @same phplib::template->set_block Public Sub set_block(ByVal A_parent, ByVal A_varname, ByVal A_name) Call SetBlock(A_parent, A_varname, A_name) End Sub
'#### '## This functions sets the value of a variable. '## '## It may be called with either a varname and a value as two strings or an '## an associative array with the key being the varname and the value being '## the new variable value. '## '## The function inserts the new value of the variable into the $varkeys and '## $varvals hashes. It is not necessary for a variable to exist in these hashes '## before calling this function. '## '## usage: oTemplate.SetVar string A_varname, string A_value '## or '## usage: oTemplate.SetVar array( A_varname1, A_value1 _ '## ,A_varname2, A_value2 _ '## , ... , ... ) _ '## , "" '## '## @param A_varname either a string containing a varname or a hash of varname/value pairs. '## @param A_value if A_varname is a string this contains the new value for the variable otherwise this parameter is ignored '## @access public '## Public Sub SetVar(ByVal A_varname, ByVal A_value) '############################################################ Dim MM_varname If Not IsArray(A_varname) Then If A_varname <> "" Then If Debug = 1 Then Response.Write "<b>SetVar:</b> (with scalar) <b>" & A_varname & "</b> = " & Server.HTMLEncode(A_value) & "<br>" & VbCrLf MM_varname = varname(A_varname) if m_oVarKeys.Exists(A_varname) Then m_oVarKeys.Remove A_varname m_oVarKeys.Add A_varname, MM_varname Else m_oVarKeys.Add A_varname, MM_varname End If If m_oVarVals.Exists(A_varname) Then m_oVarVals.Remove A_varname m_oVarVals.Add A_varname, A_value Else m_oVarVals.Add A_varname, A_value End If End If Else Call SetVars(A_varname) End If End Sub
'#### '## usage: oTemplate.SetVar array( A_varname1, A_value1 _ '## ,A_varname2, A_value2 _ '## , ... , ... ) '## @param A_varname a hash of varname/value pairs. '## @access public '## @see SetVar '## Public Sub SetVars(ByVal A_varname) '############################################################ Dim i, num If IsArray(A_varname) Then num = Ubound(A_varname) if ((num +1) mod 2) <> 0 Then Call halt("SetVars: For varname array's element not gemination.") Exit Sub Else For i = 0 To num Step 2 Call SetVar(A_varname(i), A_varname(i+1)) Next End If Else Call SetVar(A_varname, "") End If End Sub
'#### '## usage: oTemplate.SetAppendVar string A_varname, string A_value '## or '## usage: oTemplate.SetAppendVar array( A_varname1, A_value1 _ '## ,A_varname2, A_value2 _ '## , ... , ... ) _ '## , "" '## @param A_varname either a string containing a varname or a hash of varname/value pairs. '## @param A_value if A_varname is a string this contains the new value for the variable otherwise this parameter is ignored '## @access public '## @see SetVar '## Public Sub SetAppendVar(ByVal A_varname, ByVal A_value) '############################################################ Dim MM_varname, MM_string If Not IsArray(A_varname) Then If A_varname <> "" Then If Debug = 1 Then Response.Write "<b>SetAppendVar:</b> (with scalar) <b>" & A_varname & "</b> = " & Server.HTMLEncode(A_value) & "<br>" & VbCrLf MM_varname = varname(A_varname) if m_oVarKeys.Exists(A_varname) Then m_oVarKeys.Remove A_varname m_oVarKeys.Add A_varname, MM_varname Else m_oVarKeys.Add A_varname, MM_varname End If If m_oVarVals.Exists(A_varname) Then MM_string = m_oVarVals.Item(A_varname) & A_value m_oVarVals.Remove A_varname m_oVarVals.Add A_varname, MM_string Else m_oVarVals.Add A_varname, A_value End If End If Else Call SetAppendVars(A_varname) End If End Sub
'#### '## usage: oTemplate.SetAppendVars array( A_varname1, A_value1 _ '## ,A_varname2, A_value2 _ '## , ... , ... ) '## @param A_varname a hash of varname/value pairs. '## @access public '## @see SetVar '## Public Sub SetAppendVars(ByVal A_varname) '############################################################ Dim i, num If IsArray(A_varname) Then num = Ubound(A_varname) if ((num +1) mod 2) <> 0 Then Call halt("SetVars: For varname array's element not gemination.") Exit Sub Else For i = 0 To num Step 2 Call SetAppendVar(A_varname(i), A_varname(i+1)) Next End If Else Call SetAppendVar(A_varname, "") End If End Sub
'#### '## '## @same phplib::template->set_var '## Public Sub set_var(ByVal A_varname, ByVal A_value, ByVal A_append) '############################################################ If CBool(A_append) = True Then If Not IsArray(A_varname) Then Call SetAppendVar(A_varname, A_value) Else Call SetAppendVars(A_varname, A_value) End If Else If Not IsArray(A_varname) Then Call SetVar(A_varname, A_value) Else Call SetVars(A_varname, A_value) End If End If End Sub
'#### '## This function fills in all the variables contained within the variable named '## A_varname. The resulting value is returned as the function result and the '## original value of the variable varname is not changed. The resulting string '## is not "finished", that is, the unresolved variable name policy has not been '## applied yet. '## '## Returns: the value of the variable $varname with all variables substituted. '## '## usage: SubString(string A_varname) '## '## @param A_varname the name of the variable within which variables are to be substituted '## @access public '## @return string '## Public Function SubString(ByVal A_varname) '############################################################ Dim MM_String If Debug = 4 Then Response.Write "<p><b>SubString:</b> varname = " & A_varname & "</p>" & VbCrLf If Not loadfile(A_varname) Then Call halt("SubString: unable to load " & A_varname & ".") End If MM_String = GetVar(A_varname) m_oRegExp.IgnoreCase = True m_oRegExp.Global = True m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag Set Matches = m_oRegExp.Execute(MM_String) For Each Match In Matches if m_oVarVals.Exists(Match.SubMatches(1)) Then m_oRegExp.Pattern = Match.Value MM_String = m_oRegExp.Replace(MM_String, m_oVarVals.Item(Match.SubMatches(1))) End If Next SubString = MM_String End Function
'#### '## '## @same phplib::template->subst '## Public Function subst(ByVal A_varname) subst = SubString(A_varname) End Function
'#### '## This is shorthand for print SubString(A_varname). See SubString for further '## details. '## '## usage: oTemplate.WriteSubString string A_varname '## '## @param A_varname the name of the variable within which variables are to be substituted '## @access public '## @see SubString '## Public Sub WriteSubString(ByVal A_varname) '############################################################ If Debug = 4 Then Response.Write "<p><b>WriteSubString:</b> varname = " & A_varname & "</p>" & VbCrLf Response.Write SubString(A_varname) End Sub
'#### '## '## @same phplib::template->psubst '## Public Sub psubst(ByVal A_varname) Call WriteSubString(A_varname) End Sub
'#### '## The function substitutes the values of all defined variables in the variable '## named A_varname and stores or appends the result in the variable named A_target. '## '## It may be called with either a target and a varname as two strings or a '## target as a string and an array of variable names in varname. '## '## The function inserts the new value of the variable into the oVarVeys and '## $varvals hashes. It is not necessary for a variable to exist in these hashes '## before calling this function. '## '## An optional third parameter allows the value for each varname to be appended '## to the existing target variable instead of replacing it. The default is to '## replace. '## '## If A_target and A_varname are both strings, the substituted value of the '## variable A_varname is inserted into or appended to A_target. '## '## Returns: the last value assigned to A_target. '## '## usage: oTemplate.Parse string A_target, string A_varname, boolean A_append '## usage: string = oTemplate.Parse( string A_target, string A_varname, boolean A_append ) '## or '## usage: oTemplate.Parse string A_target, array(A_varname1, A_varname2, ...) , boolean A_append '## usage: string = oTemplate.Parse( string A_target, array(A_varname1, A_varname2, ...), boolean A_append) '## '## @param A_target a string containing the name of the variable into which substituted $varnames are to be stored '## @param A_varname if a string, the name the name of the variable to substitute or if an array a list of variables to be substituted '## @param A_append if true, the substituted variables are appended to $target otherwise the existing value of $target is replaced '## @access public '## @return string '## @see SubString '## '## @same phplib::template->pparse '## Public Function Parse(ByVal A_target, ByVal A_varname, ByVal A_append) '############################################################ Dim MM_String, i, num If Not IsArray(A_varname) Then If Debug = 4 Then Response.Write "<p><b>Parse:</b> (with scalar) target = " & A_target & ", varname = " & A_varname & ", append = " & A_append & "</p>" & VbCrLf MM_String = SubString(A_varname) if A_append = True Then MM_String = GetVar(A_target) & MM_String Call SetVar(A_target, MM_String) Else Call SetVar(A_target, MM_String) End If Else num = Ubound(A_varname) For i = 0 To num If Debug = 4 Then Response.Write "<p><b>Parse:</b> (with array) target = " & A_target & ", varname = " & A_varname(i) & ", append = " & A_append & "</p>" & VbCrLf MM_String = SubString(A_varname(i)) if A_append = True Then MM_String = GetVar(A_target) & MM_String Call SetVar(A_target, MM_String) Else Call SetVar(A_target, MM_String) End If Next End If
If Debug = 4 Then Response.Write "<p><b>Parse:</b> completed</p>" & VbCrLf Parse = MM_String End Function
'#### '## This is shorthand for print Parse(...) and is functionally identical. '## See Parse for further details. '## '## Returns: always returns void. '## '## usage: oTemplate.Write string A_target, string A_varname '## '## @param A_target a string containing the name of the variable into which substituted $varnames are to be stored '## @param A_varname if a string, the name the name of the variable to substitute or if an array a list of variables to be substituted '## @access public '## @return void '## @see Parse '## Public Sub Write(ByVal A_target, ByVal A_varname) '############################################################ Dim MM_string If Debug = 4 Then Response.Write "<p><b>Write:</b> passing parameters to parse...</p>" & VbCrLf MM_string = Parse(A_target, A_varname, False) MM_string = Finish(MM_string) Response.Write MM_string End Sub
'#### '## '## @see Write '## Public Sub AppendWrite(ByVal A_target, ByVal A_varname) '############################################################ Dim MM_string If Debug = 4 Then Response.Write "<p><b>Write:</b> passing parameters to parse...</p>" & VbCrLf MM_string = Parse(A_target, A_varname, True) MM_string = Finish(MM_string) Response.Write MM_string End Sub
'#### '## '## @same phplib::template->pparse '## Public Sub pparse(ByVal A_target, ByVal A_varname, ByVal A_append) '############################################################ If CBool(A_append) = True Then Call AppendWrite(A_target, A_varname) Else Call Write(A_target, A_varname) End If End Sub
'#### '## This function returns an associative object of all defined variables with the '## name as the key and the value of the variable as the value. '## '## This is mostly useful for debugging. Also note that $this->debug can be used '## to echo all variable assignments as they occur and to trace execution. '## '## Returns: a hash of all defined variable values keyed by their names. '## '## usage: oTemplate.get_vars() '## '## @access public '## @return object '## Public Function GetVars() '############################################################ If Debug = 4 Then Response.Write "<p><b>GetVars:</b> constructing dictionary of vars...</p>" & VbCrLf Set GetVars = m_oVarVals End Function
'#### '## '## @same phplib::template->get_vars '## Public Function get_vars() Set get_vars = GetVars() End Function
'#### '## This function returns the value of the variable named by A_varname. '## If A_varname references a file and that file has not been loaded yet, the '## variable will be reported as empty. '## '## When called with an array of variable names this function will return a a '## hash of variable values keyed by their names. '## '## Returns: a string or an array containing the value of $varname. '## '## usage: GetVar(string A_varname) '## or '## usage: GetVar(array A_varname) '## '## @param A_varname if a string, the name the name of the variable to get the value of, or if an array a list of variables to return the value of '## @access public '## @return string or object '## Public Function GetVar(ByVal A_varname) '############################################################ Dim MM_String, MM_oVars, i, num If Not IsArray(A_varname) Then 'MM_String = "" if A_varname <> "" Then If m_oVarVals.Exists(A_varname) Then MM_String = m_oVarVals.Item(A_varname) End If End If If Debug = 2 Then Response.Write "<b>GetVar:</b> (with scalar) <b>" & A_varname & "</b> = " & Server.HTMLEncode(MM_String) & "<br>" & VbCrLf GetVar = MM_String Else Set MM_oVars = CreateObject("Scripting.Dictionary") num = UBound(A_varname) For i=0 To num If m_oVarVals.Exists(A_varname(i)) Then MM_String = m_oVarVals.Item(A_varname(i)) MM_oVars.Add A_varname(i), MM_String End If If Debug = 2 Then Response.Write "<b>GetVar:</b> (with array) <b>" & A_varname(i) & "</b> = " & Server.HTMLEncode(MM_String) & "<br>" & VbCrLf Next Set GetVar = MM_oVars End If End Function
'#### '## '## @same phplib::template->get_var '## Public Function get_var(ByVal A_varname) If Not IsArray(A_varname) Then get_var = GetVar(A_varname) Else Set get_var = GetVar(A_varname) End If End Function
'#### '## This functions clears the value of a variable. '## '## It may be called with either a varname as a string or an array with the '## values being the varnames to be cleared. '## '## The function sets the value of the variable in the oVarKeys and oVarVals '## hashes to "". It is not necessary for a variable to exist in these hashes '## before calling this function. '## '## '## usage: oTemplate.ClearVar string A_varname '## or '## usage: oTemplate.ClearVar array (A_varname1, A_varname2, ...) '## '## @param $varname either a string containing a varname or an array of varnames. '## @access public '## @return void '## Public Sub ClearVar(ByVal A_varname) '############################################################ Dim i, num If Not IsArray(A_varname) Then If A_varname <> "" Then If Debug = 1 Then Response.Write "<b>clear_var:</b> (with scalar) <b>" & A_varname & "</b><br>" & VbCrLf Call SetVar(A_varname, "") End If Else num = UBound(A_varname) For i=0 To num If Debug = 1 Then Response.Write "<b>clear_var:</b> (with array) <b>" & A_varname(i) & "</b><br>" & VbCrLf Call SetVar(A_varname(i), "") Next End If End Sub
'#### '## '## @same phplib::template->clear_var '## Public Sub clear_var(ByVal A_varname) Call ClearVar(A_varname) End Sub
'#### '## This functions unsets a variable completely. '## '## It may be called with either a varname as a string or an array with the '## values being the varnames to be cleared. '## '## The function removes the variable from the oVarKeys and oVarVals hashes. '## It is not necessary for a variable to exist in these hashes before calling '## this function. '## '## '## usage: oTemplate.unSetVar string A_varname '## or '## usage: oTemplate.unSetVar array(A_varname1, A_varname2, ...) '## '## @param A_varname either a string containing a varname or an array of varnames. '## @access public '## Public Sub unSetVar(ByVal A_varname) '############################################################ Dim i, num If Not IsArray(A_varname) Then If A_varname <> "" Then If Debug = 1 Then Response.Write "<b>unSetVar:</b> (with scalar) <b>" & A_varname & "</b><br>" & VbCrLf If m_oVarKeys.Exists(A_varname) Then m_oVarKeys.Remove A_varname End If If m_oVarVals.Exists(A_varname) Then m_oVarVals.Remove A_varname End If End If Else num = UBound(A_varname) For i=0 To num If A_varname(i) <> "" Then If Debug = 1 Then Response.Write "<b>unSetVar:</b> (with array) <b>" & A_varname & "</b><br>" & VbCrLf If m_oVarKeys.Exists(A_varname(i)) Then m_oVarKeys.Remove A_varname(i) End If If m_oVarVals.Exists(A_varname(i)) Then m_oVarVals.Remove A_varname(i) End If End If Next End If End Sub
'#### '## '## @same phplib::template->unset_var '## Public Sub unset_var(ByVal A_varname) Call unSetVar(A_varname) End Sub
'#### '## This function returns a hash of unresolved variable names in A_varname, keyed '## by their names. '## '## Returns: a hash of varname/varname pairs or false on error. '## '## usage: GetUndefined(string A_varname) '## '## @param A_varname a string containing the name the name of the variable to scan for unresolved variables '## @access public '## @return array '## Public Function GetUndefined(ByVal A_varname) '############################################################ Dim MM_String, MM_result If Debug = 4 Then Response.Write "<p><b>GetUndefined:</b> varname = " & A_varname & "</p>" & VbCrLf If Not loadfile(A_varname) Then Call halt("get_undefined: unable to load " & A_varname & ".") GetUndefined = False Exit Function End If MM_String = GetVar(A_varname) 'Set MM_result = CreateObject("Scripting.Dictionary") m_oRegExp.IgnoreCase = True m_oRegExp.Global = True m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag Set Matches = m_oRegExp.Execute(MM_String) i = 0 For Each Match In Matches if Not m_oVarVals.Exists(Match.SubMatches(1)) Then If Debug = 4 Then Response.Write "<p><b>get_undefined:</b> undefined: " & SubMatches(1) & "</p>" & VbCrLf 'MM_result.Add Match.SubMatches(1), Match.SubMatches(1) MM_result(i) = Match.SubMatches(1) i = i + 1 End If Next 'if MM_result.Count > 0 Then ' Set GetUndefined = MM_result If IsArray(MM_result) Then GetUndefined = MM_result Else GetUndefined = False End If End Function
'#### '## '## @same phplib::template->get_undefined '## Public Function get_undefined(ByVal A_varname) '############################################################ get_undefined = GetUndefined End Function
'#### '## This function returns the finished version of $str. That is, the policy '## regarding unresolved variable names will be applied to $str. '## '## Returns: a finished string derived from A_String and unknowns. '## '## usage: Finish(string A_String) '## '## @param A_String a string to which to apply the unresolved variable policy '## @access public '## @return string '## @see Unknowns, SetUnknowns, set_unknowns '## Public Function Finish(ByVal A_String) '############################################################ Dim MM_String Select Case Unknowns case "keep" MM_String = A_String case "remove" m_oRegExp.IgnoreCase = True m_oRegExp.Global = True m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag MM_String = m_oRegExp.Replace(A_String, "") case "comment" m_oRegExp.IgnoreCase = True m_oRegExp.Global = True m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag Set Matches = m_oRegExp.Execute(A_String) For Each Match In Matches MM_String = m_oRegExp.Replace(A_String, "<!-- Template variable " & Match.SubMatches(1) &" undefined -->") Next End Select Finish = MM_String End Function
'#### '## This function returns the finished version of the value of the variable named '## by $varname. That is, the policy regarding unresolved variable names will be '## applied to the variable A_varname and the result returned. '## '## Returns: a finished string derived from the variable A_varname. '## '## usage: oTemplate.GetVariable(string A_varname) '## '## @param A_varname a string containing the name of the variable to finish '## @access public '## @return string '## @see SetUnknowns '## @see Finish '## Public Function GetVariable(ByVal A_varname) '############################################################ GetVariable = Finish(GetVar(A_varname)) End Function
'Public Function get(ByVal A_varname) '冲突不支持 'End Function
'#### '## This function prints the finished version of the value of the variable named '## by $varname. That is, the policy regarding unresolved variable names will be '## applied to the variable A_varname then it will be printed. '## '## usage: oTemplate.WriteVariable string A_varname '## '## @param A_varname a string containing the name of the variable to finish and print '## @access public '## @see SetUnknowns '## @see Finish '## Public Sub WriteVariable(ByVal A_varname) '############################################################ Response.Write Finish(GetVal(A_varname)) End Sub
'#### '## '## @see WriteVariable '## @same phplib::template->p '## Public Sub p(ByVal A_varname) Call WriteVariable(A_varname) End Sub
'#### '## When called with a relative pathname, this function will return the pathname '## with Root divpended. Absolute pathnames are returned unchanged. '## '## Returns: a string containing an absolute pathname. '## '## usage: filename(string A_filename) '## '## @param A_filename a string containing a filename '## @access private '## @return string '## @see Root, SetRoot '## '## @same phplib::template->filename '## Private Function filename(ByVal A_filename) '############################################################ Dim MM_FSO, MM_filename, MM_TempFilename, rs, sql If Debug = 4 Then Response.Write "<p><b>filename:</b> filename = " & A_filename & "</p>" & VbCrLf If Mode = "file" Then Set MM_FSO = CreateObject("Scripting.FileSystemObject") If Left(A_filename, 1) = "/" Then A_filename = Right(A_filename, len(A_filename) - 1) End If A_filename = Root & A_filename A_filename = Server.MapPath(A_filename) If Not MM_FSO.FileExists(A_filename) Then Call halt("filename: file " & A_filename & " does not exist.") Else MM_filename = A_filename End If ElseIf Mode = "db" Then A_filename = Split(A_filename, ".") MM_TempFilename = A_filename(0) sql = "SELECT tpldata_id FROM " & DataTable & " WHERE tplcat_id =" & Root &" AND tpldata_name='" & MM_TempFilename &"'" Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sql, m_oConn, AdOpenForwardOnly, AdLockReadOnly, adCmdText If rs.EOF Then Call halt("filename: file " & MM_TempFilename & " does not exist.") Else MM_filename = rs("tpldata_id") End If Set rs = Nothing If Debug = 3 Then Response.Write "<p><b>filename:</b> sql = " & sql & "</p>" & VbCrLf End If filename = MM_filename End Function
'#### '## If a variable's value is undefined and the variable has a filename stored in '## ofile.Item(A_varname) then the backing file will be loaded and the file's '## contents will be assigned as the variable's value. '## '## Note that the behaviour of this function changed slightly after the 7.2d '## release. Where divviously a variable was reloaded from file if the value '## was empty, now this is not done. This allows a variable to be loaded then '## set to "", and also divvents attempts to load empty variables. Files are '## now only loaded if oVarVals.Item(A_varname) is unset. '## '## Returns: true on success, false on error. '## '## usage: loadfile(string A_varname) '## '## @param A_varname a string containing the name of a variable to load '## @access private '## @return boolean '## @see SetFile, SetFiles '## '## @same phplib::template->loadfile '## Private Function loadfile(ByVal A_varname) '############################################################ Dim MM_FSO, MM_oFile, MM_filename, MM_FileSting, MM_bool If Debug = 4 Then Response.Write "<p><b>loadfile:</b> varname = " & A_varname & "</p>" & VbCrLf MM_bool = true If Not m_oFile.Exists(A_varname) Then loadfile = MM_bool If Debug = 4 Then Response.Write "<p><b>loadfile:</b> varname " & A_varname & " does not reference a file</p>" & VbCrLf Exit Function End If If m_oVarVals.Exists(A_varname) Then loadfile = MM_bool If Debug = 4 Then Response.Write "<p><b>loadfile:</b> varname " & A_varname & " is already loaded</p>" & VbCrLf Exit Function End If MM_filename = m_oFile.Item(A_varname) If Mode = "file" Then Set MM_FSO = CreateObject("Scripting.FileSystemObject") Set MM_oFile = MM_FSO.OpenTextFile(MM_filename) MM_FileSting = MM_oFile.ReadAll 'MM_FileSting = Trim(MM_FileSting) If MM_FileSting = "" Then MM_bool = false Call halt("loadfile: While loading " & A_varname & ", " & MM_filename & " does not exist or is empty.") Else If Debug = 4 Then Response.Write "<b>loadfile:</b> loaded " & MM_filename & " into " & A_varname & "<br>" & VbCrLf Call SetVar(A_varname, MM_FileSting) End If MM_oFile.Close Set MM_oFile = Nothing set FSO = nothing ElseIf Mode = "db" Then sql = "SELECT tpldata_text FROM " & DataTable & " WHERE tpldata_id =" & MM_filename Set rs = Server.CreateObject("ADODB.Recordset") rs.Open sql, m_oConn, AdOpenForwardOnly, AdLockReadOnly, adCmdText If rs.EOF Then MM_bool = false Call halt("filename: file " & MM_TempFilename & " does not exist.") Else MM_FileSting = rs("tpldata_text") Call SetVar(A_varname, MM_FileSting) End If Set rs = Nothing If Debug = 3 Then Response.Write "<p><b>loadfile:</b> sql = " & sql & "</p>" & VbCrLf End If loadfile = MM_bool End Function
'#### '## This function will construct a regexp for a given variable name with any '## special chars quoted. '## '## Returns: a string containing an escaped variable name. '## '## usage: varname(string A_varname) '## '## @param A_varname a string containing a variable name '## @access private '## @return string '## @same phplib::template->varname '## Private Function varname(ByVal A_varname) '############################################################ varname = BeginTag & A_varname & EndTag End Function
'#### '## This function is called whenever an error occurs and will handle the error '## according to the policy defined in IsHalt. Additionally the '## error message will be saved in m_strLastError. '## '## Returns: always returns false. '## '## usage: halt(string A_message) '## '## @param $msg a string containing an error message '## @access private '## @return void '## @see IsHalt '## Private Sub halt(ByVal A_message) '############################################################ m_strLastError = A_message If IsHalt <> "no" Then Call haltmsg(A_message) If IsHalt = "yes" Then Response.Write "<b>Halted.</b>" Response.End End If End Sub
'#### '## This function prints an error message. '## It can be overridden by your subclass of Template. It will be called with an '## error message to display. '## '## usage: haltmsg(string A_message) '## '## @param A_message a string containing the error message to display '## @access public '## @return void '## @see halt '## Public Sub haltmsg(ByVal A_message) '############################################################ Response.Write "<b>Template Error:</b>" & A_message & "<br>" End Sub
'#### '## Class constructor, set class default attributes, you can change it '## @see Property Let Debug '## @see Property Let Mode '## @see Property Let CatTable '## @see Property Let DataTable '## @see Property Let Unknown '## @see Property Let IsHalt '## @see Property Let BeginTag '## @see Property Let EndTag '#### Private Sub class_Initialize Debug = 0 Mode = "file" CatTable = "TplCat" DataTable = "TplData" Unknowns = "remove" IsHalt = "yes" m_strLastError = "" BeginTag = "{" EndTag = "}" m_Root = "templates/" Set m_oFile = CreateObject("Scripting.Dictionary") Set m_oVarKeys = CreateObject("Scripting.Dictionary") Set m_oVarVals = CreateObject("Scripting.Dictionary") Set m_oRegExp = New RegExp
m_blnConnectionState = False
m_strName = "aspTemplate" m_strVersion = "2.0.0"
If Debug = 4 Then Response.Write "<p><b>Template:</b> root = " & m_Root & ", unknowns = " & Unknowns & "</p>" & VbCrLf
End Sub
'#### '## Class destructor, free memory. '#### Private Sub class_Terminate Set m_oFile = Nothing Set m_oVarKeys = Nothing Set m_oVarVals = Nothing Set m_oRegExp = Nothing Call CloseTemplateDatabase() End Sub
End Class
%> (出处:phping(中国数据在线)) |