{@Replace(<,<)}<%
'************************
'*                      *
'*  Huncent Xmark Class	*
'*  Version : 1.1.0     *
'*  Author  : Icystar	*
'*  Comment : 100601	*
'*                      *
'************************

Class CXmark
	Private Logs, Temp, Mark, Locked
	Private xSign, sTime, rTime, Times, Evals
	
	Public Dir, Ext, Name, File
	Public Debug, Version, CodePage, Charset
	
	Public Sub Show()
		Response.Write(Html)
	End Sub
	
	Public Sub Lock(sMark)
		Locked = sMark
	End Sub
	
	Public Sub UnLock(sMark)
		Dim Key, Tmp
		For Each Key In Temp
			If InStr(Key, sMark &"$")>0 Then
				Tmp = Mid(Key, InStrRev(Key, "$"))
				Mark(Tmp) = Temp(Key)
				Temp.Remove(Key)
			End If
		Next
		Locked = ""
	End Sub
	
	Public Property Get Items()
		Items = Mark.Keys()
	End Property
	
	Public Property Get SkinDir()
		SkinDir = Dir & Name &"/"
		SkinDir = Replace(SkinDir,"\","/")
		SkinDir = Replace(SkinDir,"//","/")
	End Property
	
	Public Property Let Item(sKey, sVal)
		If Locked<>"" Then LockMark(sKey)
		If IsNull(sVal) Then
			sVal = ""
		ElseIf IsArray(sVal) Then
			sVal = Join(sVal,",")
		ElseIf IsObject(sVal) Then
			sVal = "[Xmark:Object]"
		ElseIf TypeName(sVal)="Unknown" Then
			sVal = "[Xmark:Unknown]"
		ElseIf TypeName(sVal)="Nothing" Then
			sVal = "[Xmark:Nothing]"
		End If
		If Mark.Exists(sKey) Then
			Mark(sKey) = CStr(sVal)
		Else
			Mark.Add sKey, CStr(sVal)
		End If
	End Property
	
	Public Default Property Get Item(sKey)
		If Mark.Exists(sKey) Then
			Item = Mark(sKey)
		End If
	End Property
	
	Public Property Get Html()
		If Response.Charset="" Then 
			Response.Charset = Charset
			Session.CodePage = CodePage
		End If
		Item("$Charset") = Charset
		Item("$SkinDir") = SkinDir
		Html = Parse(Load(File))
		rTime = (Timer()-sTime) * 1000
		Item("$XmarkLogs") = Logs
		Item("$XmarkTimer") = FormatNumber(rTime,3)
		Item("$XmarkTimes") = Times + 1
		Item("$XmarkEvals") = Evals + 1
		Html = Html & xSign
		Html = Parse(Html)
	End Property
	
	Public Property Get Reset()
		Logs = "Xmark"
		Times = 0
		Evals = 0
		sTime = Timer()
		If Locked<>"" Then
			Temp.RemoveAll()
			Locked = ""
		End If
	End Property
	
	Public Function Load(ByVal Tpl)
		Dim oStream, sFile, fso
		sFile = SkinDir & Tpl & Ext
		sFile = Server.MapPath(sFile)
		Set fso = Server.CreateObject("Scripting.FileSystemObject")
		If fso.FileExists(sFile) Then
			Set oStream = Server.CreateObject("Adodb."&"Stream")
			oStream.Type = 2
			oStream.Mode = 3
			oStream.Open
			oStream.Charset = Charset
			oStream.LoadFromFile(sFile)
			Load = oStream.ReadText
			oStream.Close
			Set oStream = Nothing
		Else
			Load = "Cannot find the template file "& Tpl & Ext
		End If
		Set fso = Nothing
	End Function
	
	Public Function Parse(ByVal strHtml)
		If IsNull(strHtml) Then Exit Function
		
		strHtml = ParseCtrlFree(strHtml)
		strHtml = ParseCtrlFunc(strHtml)
		strHtml = ParseFuncFree(strHtml)
		strHtml = ParseFunction(strHtml)
		strHtml = ParseVariable(strHtml)
		strHtml = ParseVariable(strHtml)

		Times = Times+1
		Parse = strHtml
	End Function
	
	Private Function ParseCtrlFree(ByVal strHtml)
		Dim RegEx, Matche, Matchs
		Dim sMark, sFree, sPars, sHtml, sValue
		On Error Resume Next
		Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Global = True
		' {@If.Free(fact)}{/If.Free} ...
		RegEx.Pattern = "{(@)((([_a-z0-9]+?)\.)([^{]*?))\(([^{]*?)\)}([\s\S]+?){/\2}"
		Set Matchs = RegEx.Execute(strHtml)
		For Each Matche In Matchs
			sMark = RegEx.Replace(Matche.Value,"$1$3")
			sFree = RegEx.Replace(Matche.Value,"$5")
			sPars = RegEx.Replace(Matche.Value,"$6")
			sHtml = RegEx.Replace(Matche.Value,"$7")
			If Mark.Exists(sMark) Then
				sPars = ParsePars(sPars)
				sValue = Eval(Mark(sMark) &"("& sPars &", sFree, sHtml)")
				If Err.Number<>0 Then sValue = ParseDebug(sMark)
				If Not IsEmpty(sValue) Then
					strHtml = Replace(strHtml, Matche.Value, Parse(sValue))
				End If
				Logs = Logs &", "& sMark & sFree
				Evals = Evals + 1
			End If
		Next
		Set Matchs = Nothing
		Set RegEx = Nothing
		
		ParseCtrlFree = strHtml
	End Function
	
	Private Function ParseCtrlFunc(ByVal strHtml)
		Dim RegEx, Matche, Matchs
		Dim sMark, sPars, sHtml, sValue
		On Error Resume Next
		Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Global = True
		' {@If(fact)}{/If} ...
		RegEx.Pattern = "{(@([_a-z0-9]+?))\(([^{]*?)\)}([\s\S]*?){/\2}"
		Set Matchs = RegEx.Execute(strHtml)
		For Each Matche In Matchs
			sMark = RegEx.Replace(Matche.Value,"$1")
			sPars = RegEx.Replace(Matche.Value,"$3")
			sHtml = RegEx.Replace(Matche.Value,"$4")
			If Mark.Exists(sMark) Then
				sPars = ParsePars(sPars)
				sValue = Eval(Mark(sMark) &"("& sPars &", sHtml)")
				If Err.Number<>0 Then sValue = ParseDebug(sMark)
				If Not IsEmpty(sValue) Then
					strHtml = Replace(strHtml, Matche.Value, Parse(sValue))
				End If
				Logs = Logs &", "& sMark
				Evals = Evals + 1
			End If
		Next
		Set Matchs = Nothing
		Set RegEx = Nothing
		
		ParseCtrlFunc = strHtml
	End Function
	
	Private Function ParseFuncFree(ByVal strHtml)
		Dim RegEx, Matche, Matchs
		Dim sMark, sFree, sPars, sValue
		On Error Resume Next
		Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Global = True
		' {@Include.Free(inc)/} ...
		RegEx.Pattern = "{(@([_a-z0-9]+?)\.)([^{]*?)\(([^{]*?)\)/}"
		Set Matchs = RegEx.Execute(strHtml)
		For Each Matche In Matchs
			sMark = RegEx.Replace(Matche.Value,"$1")
			sFree = RegEx.Replace(Matche.Value,"$3")
			sPars = RegEx.Replace(Matche.Value,"$4")
			If Mark.Exists(sMark) Then
				sPars = ParsePars(sPars)
				sValue = Eval(Mark(sMark) &"("& sPars &", sFree)")
				If Err.Number<>0 Then sValue = ParseDebug(sMark)
				If Not IsEmpty(sValue) Then
					strHtml = Replace(strHtml, Matche.Value, Parse(sValue))
				End If
				Logs = Logs &", "& sMark
				Evals = Evals + 1
			End If
		Next
		Set Matchs = Nothing
		Set RegEx = Nothing
		
		ParseFuncFree = strHtml
	End Function
	
	Private Function ParseFunction(ByVal strHtml)
		Dim RegEx, Matche, Matchs
		Dim sMark, sPars, sValue
		'On Error Resume Next
		Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Global = True
		' {@Include(inc)/} ...
		RegEx.Pattern = "{(@([_a-z0-9]+?))\(([^{]*?)\)/}"
		Set Matchs = RegEx.Execute(strHtml)
		For Each Matche In Matchs
			sMark = RegEx.Replace(Matche.Value, "$1")
			sPars = RegEx.Replace(Matche.Value, "$3")
			If Mark.Exists(sMark) Then
				sPars = ParsePars(sPars)
				sValue = Eval(Mark(sMark) &"("& sPars &")")
				If Err.Number<>0 Then sValue = ParseDebug(sMark)
				If Not IsEmpty(sValue) Then
					strHtml = Replace(strHtml, Matche.Value, Parse(sValue))
				End If
				Logs = Logs &", "& sMark
				Evals = Evals + 1
			End If
		Next
		Set Matchs = Nothing
		Set RegEx = Nothing
		
		ParseFunction = strHtml
	End Function
	
	Private Function ParseVariable(ByVal strHtml)
		Dim RegEx, Matche, Matchs
		Dim sMark, sValue
		
		Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Global = True
		' {$SkinDir} ...
		RegEx.Pattern = "{(\$[_a-z0-9.]+?)}"
		Set Matchs = RegEx.Execute(strHtml)
		For Each Matche In Matchs
			sMark = RegEx.Replace(Matche.Value, "$1")
			If Mark.Exists(sMark) Then
				sValue = Mark(sMark)
				If IsNull(sValue) Then sValue = ""
				If Not IsEmpty(sValue) Then
					strHtml = Replace(strHtml, Matche.Value, sValue)
				End If
				Logs = Logs &", "& sMark
				Evals = Evals + 1
			End If
		Next
		Set Matchs = Nothing
		Set RegEx = Nothing
		
		ParseVariable = strHtml
	End Function
	
	Private Function ParsePars(ByVal sPars)
		Dim RegEx, Matche, Matchs
		Dim aPars, sParm, nParm, sMark, sValue
		nParm = 0
		ParsePars = ""
		If Trim(sPars)="" Then sPars = " "
		aPars = Split(sPars, ",")
		Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Global = True
		RegEx.Pattern = "(\$[_a-z0-9.]+)"
		For Each sParm In aPars
			Set Matchs = RegEx.Execute(sParm)
			For Each Matche In Matchs
				sMark = RegEx.Replace(Matche.Value, "$1")
				sValue = QuotStr(Mark(sMark))
				sParm = Replace(sParm, Matche.Value, sValue)
				Evals = Evals + 1
			Next
			Set Matchs = Nothing
			ParsePars = ParsePars & QuotStr(sParm)
			If nParm0 Then
			If Debug=True Then
				sDebug = ""
				sDebug = sDebug & "[Xmark"& sMark &"]("& Err.Number &")"& Err.Description
				sDebug = sDebug & ""
			End If
			Err.Clear
		End If
		ParseDebug = sDebug
	End Function

	Private Sub LockMark(Key)
		If Not Temp.Exists(Locked & Key) Then
			Temp.Add Locked & Key, Mark(Key)
		End If
	End Sub
	
	Private Function CDir(sDir)
		CDir = Replace(Replace(sDir &"/", "\", "/"), "//", "/")
	End Function
	
	Private Function QuotStr(ByVal str)
		QuotStr = str
		If LCase(str)="true" Or LCase(str)="false" Then Exit Function
		If Left(str, 1)="""" And Right(str, 1)="""" Then Exit Function
		If Not IsNumeric(str) Then
			str = Replace(str, """", """""")
			str = """"& str &""""
		End If
		If Trim(str)="" Then str = """"""
		QuotStr = str
	End Function
	
	Private Function FileName()
		FileName = Request.ServerVariables("Script_Name")
		FileName = Mid(FileName, InStrRev(FileName, "/")+1)
		If FileName<>"" Then 
			FileName = Left(FileName, InStr(FileName, ".")-1)
		Else
			FileName = "index"
		End If
	End Function
	
	Private Sub Class_Initialize()
		Ext = ".html"
		Dir = "template/"
		Name = "default"
		File = FileName()
		Logs = "Xmark"
		Times = 0
		Evals = 0
		sTime = Timer()
		Locked = ""
		Version = "1.1.0"
		If IsEmpty(X_DEBUG) Then
			Debug = False
		Else
			Debug = X_DEBUG
		End If
		If IsEmpty(X_CHARSET) Then
			Charset = "UTF-8"
		Else
			Charset = X_CHARSET
		End If
		If IsEmpty(X_CODEPAGE) Then
			CodePage = 65001
		Else
			CodePage = X_CODEPAGE
		End If
		
		Set Mark = Server.CreateObject("Scripting.Dictionary")
		Mark.CompareMode = vbTextCompare
		Set Temp = Server.CreateObject("Scripting.Dictionary")
		Temp.CompareMode = vbTextCompare
		Item("$SkinDir") = SkinDir
		Item("$Software") = "Xmark Template Engine Version "& Version
		xSign = ""
	End Sub
	
	Private Sub Class_Terminate()
		If IsObject(Mark) Then Set Mark = Nothing
		If IsObject(Temp) Then Set Temp = Nothing
	End Sub	
End Class

Function XmarkClose()
	XmarkClose = ""
	If IsObject(Xmark) Then
		Set Xmark = Nothing
	End If
	If IsObject(Conn) Then
		Set Conn = Nothing
	End If
End Function

Function XmarkHtml()
	If IsObject(Xmark) Then
		XmarkHtml = Xmark.Html
		Set Xmark = Nothing
	End If
	If IsObject(Conn) Then
		Set Conn = Nothing
	End If
End Function

Function XmarkShow()
	If IsObject(Xmark) Then
		Xmark.Show
		Set Xmark = Nothing
	End If
	If IsObject(Conn) Then
		Set Conn = Nothing
	End If
End Function
%>{/Replace}