%
'Template class @0-C358BBDE
Const tpParse = False
Const tpParseSafe = True
Const ccsCacheHTML = 1
Const ccsCacheArray = 2 ' Reserved
Const ccsCacheXML = 3 ' Reserved
Const ccsOpenForReading = 1
Class clsTemplate
Public Tree ' Array
Public TreePaths ' Array
Public Encoding
Private TreePath ' String
Private TreeSize ' Integer
Private mCache ' Object
Private LONG_MAX_VALUE
Private BEGIN_OPEN
Private BEGIN_CLOSE
Private BEGIN_OPEN_LENGTH
Private BEGIN_CLOSE_LENGTH
Private END_OPEN
Private END_CLOSE
Private END_OPEN_LENGTH
Private END_CLOSE_LENGTH
Private BLOCK_PATH
Private BLOCK_TYPE
Private BLOCK_VALUE
Private TYPE_VARIABLE
Private TYPE_BEGIN_BLOCK
Private TYPE_END_BLOCK
Private TYPE_TEXT
Private Sub Class_Initialize()
Tree = Array(0)
TreePath = ""
Set mCache = Nothing
LONG_MAX_VALUE = 2147483647
BEGIN_OPEN = ""
BEGIN_OPEN_LENGTH = 11
BEGIN_CLOSE_LENGTH = 4
END_OPEN = ""
END_OPEN_LENGTH = 8
END_CLOSE_LENGTH = 4
BLOCK_PATH = 0
BLOCK_TYPE = 1
BLOCK_VALUE = 2
TYPE_VARIABLE = 0
TYPE_BEGIN_BLOCK = 1
TYPE_END_BLOCK = 2
TYPE_TEXT = 3
End Sub
Property Set Cache(newCache)
Set mCache = newCache
mCache.Encoding=Encoding
End Property
Sub LoadTemplate(FilePath)
Dim TemplateArrays
If NOT (mCache Is Nothing) Then
If mCache.ItemExists(FilePath) Then
Select Case mCache.CacheType
Case ccsCacheHTML
TemplateArrays = BuildArraysFromHTML(mCache.Items(FilePath).Content)
End Select
Tree = TemplateArrays(0) : TreePaths = TemplateArrays(1)
Else
Err.raise 1050, "Template engine", "Template engine: LoadTemplate failed. File " & FilePath & " not found."
End If
Else
Err.raise 1050, "Template engine", "Template engine: LoadTemplate failed. Template repository is not set."
End If
End Sub
Function BuildArraysFromHTML(FileContent)
Dim TreePaths(), Tree()
Dim RootName : RootName = "main"
Dim CurrentPosition : CurrentPosition = 1
' Brackets - two-dimensional array contains tag and block positions.
' 0 - Curly bracket {}
' 1 - Begin block
' 2 - End block
' Array elements:
' 0 - name, 1 - beginning tag bracket/block, 2 - ending tag bracket/block, 3 - number of template elements
Const BLOCK_NAME = 0
Const BLOCK_BEGIN = 1
Const BLOCK_END = 2
Const BLOCK_AMOUNT = 3
Dim Brackets(3)
Dim Counters(3), I
Dim CurrentNode : CurrentNode = 0
Dim Values(3)
Dim BlockType
' Brackets(0) = GetRegExp("\{[^:;\(\) \}<]*\}", FileContent) 12/22/2001
Brackets(0) = GetRegExp("\{([A-z]+\d*( [A-z]+\d*)*)+\}", FileContent)
Brackets(1) = GetRegExp(BEGIN_OPEN & "[^-]*" & BEGIN_CLOSE, FileContent)
Brackets(2) = GetRegExp(END_OPEN & "[^-]*" & END_CLOSE, FileContent)
For I = 0 to 2
If Brackets(I)(BLOCK_AMOUNT) > 0 Then
Values(I) = Brackets(I)(BLOCK_BEGIN)(0)
Else
Values(I) = LONG_MAX_VALUE
End If
Counters(I) = 0
Next
Dim Paths(30), PathLength : PathLength = 0 : Paths(0) = RootName
CurrentNode = CurrentNode + 1
ReDim Preserve Tree(CurrentNode)
Tree(CurrentNode - 1) = Array("/" & RootName & "/*", TYPE_BEGIN_BLOCK, "")
BlockType = MinValue(Values)
While Not (BlockType = LONG_MAX_VALUE)
If (Brackets(BlockType)(BLOCK_BEGIN)(Counters(BlockType)) - CurrentPosition + 1) > 0 Then
CurrentNode = CurrentNode + 1
ReDim Preserve Tree(CurrentNode)
Tree(CurrentNode - 1) = Array(GetPath(Paths, "@text"), TYPE_TEXT, Mid(FileContent, CurrentPosition, Brackets(BlockType)(BLOCK_BEGIN)(Counters(BlockType)) - CurrentPosition + 1))
CurrentPosition = Brackets(BlockType)(BLOCK_END)(Counters(BlockType)) + 1
else
CurrentPosition = Brackets(BlockType)(BLOCK_END)(Counters(BlockType)) + 1
End If
CurrentNode = CurrentNode + 1
ReDim Preserve Tree(CurrentNode)
Select Case BlockType
Case TYPE_VARIABLE
Tree(CurrentNode - 1) = Array(GetPath(Paths, GetName(Brackets(BlockType)(BLOCK_NAME)(Counters(BlockType)), BlockType)) & "/*", BlockType, "")
Case TYPE_BEGIN_BLOCK
PathLength = PathLength + 1
Paths(PathLength) = GetName(Brackets(BlockType)(BLOCK_NAME)(Counters(BlockType)), BlockType)
Tree(CurrentNode - 1) = Array(GetPath(Paths, Empty) & "*", BlockType, "")
Case TYPE_END_BLOCK
Tree(CurrentNode - 1) = Array(GetPath(Paths, Empty) & "*", BlockType, "")
Paths(PathLength) = ""
PathLength = PathLength - 1
End Select
Counters(BlockType) = Counters(BlockType) + 1
If Counters(BlockType) = Brackets(BlockType)(BLOCK_AMOUNT) Then
Values(BlockType) = LONG_MAX_VALUE
Else
Values(BlockType) = Brackets(BlockType)(BLOCK_BEGIN)(Counters(BlockType))
end if
BlockType = MinValue(Values)
Wend
If CurrentPosition < Len(FileContent) Then
CurrentNode = CurrentNode + 1
ReDim Preserve Tree(CurrentNode)
Tree(CurrentNode - 1) = Array("/" & RootName & "/@text", TYPE_TEXT, Right(FileContent, Len(FileContent) - CurrentPosition + 1))
End If
CurrentNode = CurrentNode + 1
ReDim Preserve Tree(CurrentNode)
Tree(CurrentNode - 1) = Array("/" & RootName & "/*", TYPE_END_BLOCK, "")
TreeSize = UBound(Tree) - 1
ReDim TreePaths(TreeSize + 1)
For I = 0 To TreeSize
TreePaths(I) = Tree(I)(BLOCK_PATH) & ":" & I
Next
BuildArraysFromHTML = Array(Tree, TreePaths)
End Function
Sub PrintBlocks()
Dim I
Response.Write "
"
For I = 0 To TreeSize
Response.Write ""
Response.Write "" & Tree(I)(BLOCK_PATH) & " | "
Response.Write "" & Tree(I)(BLOCK_TYPE) & " | "
Response.Write "" & Server.HTMLEncode(Tree(I)(BLOCK_VALUE)) & " | "
Response.Write "" & TreePaths(I) & " | "
Response.Write "
"
Next
Response.Write "
"
End Sub
Sub PrintArray()
Dim I, J
Response.Write ""
For I = 0 To TreeSize
Response.Write ""
For J = 0 To UBound(Tree(I))
Response.Write "" & Server.HTMLEncode(Tree(I)(J)) & " | "
Next
Response.Write "
"
Next
Response.Write "
"
End Sub
Sub SetPath(NewPath)
TreePath = NewPath
End Sub
Property Let Path(NewPath)
TreePath = NewPath
End Property
Property Get Path()
Path = TreePath
End Property
Sub SetVar(VariableName, Value)
Dim VariablePaths, I, VariablePosition, VariablePath
VariablePaths = Filter(TreePaths, "/" & TreePath & VariableName & "/*")
For I = 0 To UBound(VariablePaths)
VariablePath = VariablePaths(i)
VariablePosition = CLng(Mid(VariablePath, InStr(VariablePath, ":") + 1))
If Tree(VariablePosition)(BLOCK_TYPE) = TYPE_VARIABLE or Tree(VariablePosition)(BLOCK_TYPE) = TYPE_BEGIN_BLOCK Then Tree(VariablePosition)(BLOCK_VALUE) = Value
Next
End Sub
Function GetVar(VariableName)
Dim VariablePaths, I, VariablePosition, VariablePath, Result, TotalVariables
VariablePaths = Filter(TreePaths, "/" & TreePath & VariableName & "/*")
TotalVariables = UBound(VariablePaths)
If TotalVariables > 0 Then
If (Tree(VariablePosition)(BLOCK_TYPE) = TYPE_VARIABLE AND TotalVariables > 0) OR _
(Tree(VariablePosition)(BLOCK_TYPE) = TYPE_BEGIN_BLOCK AND TotalVariables > 1) Then
' ERROR
Else
VariablePath = VariablePaths(0)
VariablePosition = CLng(Mid(VariablePath, InStr(VariablePath, ":") + 1))
Result = Tree(VariablePosition)(BLOCK_VALUE)
End If
Else
Result = ""
End If
GetVar = Result
End Function
Function GetHTML(BlockName)
Dim BlockPaths, I, BlockPath
Dim BeginBlockIndex, EndBlockIndex, TargetIndex
Dim BlockContent, TreeDeep
TreeDeep = 0
BlockPaths = Filter(TreePaths, "/" & TreePath & BlockName & "/*")
If ((UBound(BlockPaths) - LBound(BlockPaths)) <> 1) Then
Err.Raise 1050, "Template Engine.", "Parsing function: Block """ & BlockName & """ cannot be found or selected."
Else
BlockPath = BlockPaths(0)
BeginBlockIndex = CLng(Mid(BlockPath, InStr(BlockPath, ":") + 1))
End If
GetHTML = Tree(BeginBlockIndex)(BLOCK_VALUE)
End Function
Sub ParseAndPrint(BlockName, Accumulate, Output, TargetBlock, SafeParse)
Dim BlockPaths, I, BlockPath
Dim BeginBlockIndex, EndBlockIndex, TargetIndex
Dim BlockContent, TreeDeep
TreeDeep = 0
BlockPaths = Filter(TreePaths, "/" & TreePath & BlockName & "/*")
If ((UBound(BlockPaths) - LBound(BlockPaths)) <> 1) Then
If NOT SafeParse Then _
Err.Raise 1050, "Template Engine.", "Parsing function: Block """ & BlockName & """ cannot be found or selected."
Else
BlockPath = BlockPaths(0)
BeginBlockIndex = CLng(Mid(BlockPath, InStr(BlockPath, ":") + 1))
BlockPath = BlockPaths(1)
EndBlockIndex = CLng(Mid(BlockPath, InStr(BlockPath, ":") + 1))
For i = BeginBlockIndex + 1 To EndBlockIndex - 1
If Tree(i)(BLOCK_TYPE) = TYPE_BEGIN_BLOCK Then
TreeDeep = TreeDeep + 1
If TreeDeep = 1 Then BlockContent = BlockContent & Tree(i)(BLOCK_VALUE)
ElseIf Tree(i)(BLOCK_TYPE) = TYPE_END_BLOCK Then
TreeDeep = TreeDeep - 1
ElseIf TreeDeep = 0 Then
BlockContent = BlockContent & Tree(i)(BLOCK_VALUE)
End If
Next
If IsEmpty(TargetBlock) Then
TargetIndex = BeginBlockIndex
Else
BlockPaths = Filter(TreePaths, "/" & TreePath & TargetBlock & "/*")
BlockPath = BlockPaths(0)
TargetIndex = CLng(Mid(BlockPath, InStr(BlockPath, ":") + 1))
End If
If Accumulate Then
Tree(TargetIndex)(BLOCK_VALUE) = Tree(TargetIndex)(BLOCK_VALUE) & BlockContent
Else
Tree(TargetIndex)(BLOCK_VALUE) = BlockContent
End If
If Output Then Response.Write Tree(BeginBlockIndex)(BLOCK_VALUE)
End If
End Sub
Sub ParseBlockByIndex(BeginBlockIndex, EndBlockIndex, Accumulate)
Dim i, BlockContent, TreeDeep
TreeDeep = 0
For i = BeginBlockIndex + 1 To EndBlockIndex - 1
If Tree(i)(BLOCK_TYPE) = TYPE_BEGIN_BLOCK Then
TreeDeep = TreeDeep + 1
If TreeDeep = 1 Then BlockContent = BlockContent & Tree(i)(BLOCK_VALUE)
ElseIf Tree(i)(BLOCK_TYPE) = TYPE_END_BLOCK Then
TreeDeep = TreeDeep - 1
ElseIf TreeDeep = 0 Then
BlockContent = BlockContent & Tree(i)(BLOCK_VALUE)
End If
Next
If Accumulate Then
Tree(BeginBlockIndex)(BLOCK_VALUE) = Tree(BeginBlockIndex)(BLOCK_VALUE) & BlockContent
Else
Tree(BeginBlockIndex)(BLOCK_VALUE) = BlockContent
End If
End Sub
Function BlockExists(BlockName, BlockType)
Dim BlockPaths, Result : Result = False
BlockPaths = Filter(TreePaths, "/" & TreePath & BlockName & "/*")
If BlockType = "block" Then
If (UBound(BlockPaths) - LBound(BlockPaths)) = 1 Then _
Result = True
ElseIf BlockType = "variable" Then
If (UBound(BlockPaths) - LBound(BlockPaths)) = 0 Then _
Result = True
Else
Err.Raise 1050, "Template library", "BlockExists function: Invalid BlockType parameter."
End If
BlockExists = Result
End Function
Sub HideBlock(BlockName)
SetVar BlockName, ""
End Sub
Sub Parse(BlockName, Accumulate)
ParseAndPrint BlockName, Accumulate, False, Empty, tpParse
End Sub
Sub PParse(BlockName, Accumulate)
ParseAndPrint BlockName, Accumulate, True, Empty, tpParse
End Sub
Sub ParseTo(BlockName, Accumulate, TargetBlock)
ParseAndPrint BlockName, Accumulate, False, TargetBlock, tpParse
End Sub
Sub ParseSafe(BlockName, Accumulate)
ParseAndPrint BlockName, Accumulate, False, Empty, tpParseSafe
End Sub
Sub ParseSafeTo(BlockName, Accumulate, TargetBlock)
ParseAndPrint BlockName, Accumulate, False, TargetBlock, tpParseSafe
End Sub
Function GetPath(Paths, PathAdding)
Dim Path : Path = Join(Paths, "/")
GetPath = "/" & Left(Path, InStr(Path, "//")) & PathAdding
End Function
Function GetFormattedTree()
Dim Result : Result = ""
Dim I
For I = 0 To UBound(Tree)
If IsArray(Tree(I)) Then
Result = Result & Tree(I)(BLOCK_PATH) & " "
Else
Result = Result & Tree(I) & " "
End If
Next
End Function
Function GetName(BlockString, BlockType)
Select Case BlockType
Case TYPE_VARIABLE:
GetName = "@" & mid(BlockString, 2, len(BlockString) - 2)
Case TYPE_BEGIN_BLOCK:
GetName = mid(BlockString, BEGIN_OPEN_LENGTH + 1, len(BlockString) - BEGIN_CLOSE_LENGTH - BEGIN_OPEN_LENGTH)
Case TYPE_END_BLOCK:
GetName = mid(BlockString, END_OPEN_LENGTH + 1, len(BlockString) - END_CLOSE_LENGTH - END_OPEN_LENGTH)
End Select
End Function
Function SetBlockHTML(Block, HTML)
Tree(Block.BeginOfBlock)(BLOCK_VALUE) = HTML
End Function
Function MinValue(Values)
Dim MinimumType, MinimumValue, I
MinimumType = LONG_MAX_VALUE
MinimumValue = LONG_MAX_VALUE
For I = 0 To 2
If Values(I) < MinimumValue Then
MinimumValue = Values(I)
MinimumType = I
End If
Next
MinValue = MinimumType
End Function
Function GetRegExp(RegExpPattern, FileContent)
Dim MatchesValues(), MatchesBeginIndexes(), MatchesEndIndexes()
Dim RegExpObject, Matches, TotalMatches, I
Set RegExpObject = New RegExp
RegExpObject.Pattern = RegExpPattern
RegExpObject.IgnoreCase = True
RegExpObject.Global = True
Set Matches = RegExpObject.Execute(FileContent)
Set RegExpObject = Nothing
If Matches.Count > 0 Then
TotalMatches = Matches.Count
ReDim MatchesValues(TotalMatches)
ReDim MatchesBeginIndexes(TotalMatches)
ReDim MatchesEndIndexes(TotalMatches)
Else
TotalMatches = 0
End If
For I = 0 To TotalMatches - 1
MatchesValues(I) = Matches.Item(I).Value
MatchesBeginIndexes(I) = Matches.Item(I).FirstIndex
MatchesEndIndexes(I) = Matches.Item(I).FirstIndex + Len(Matches.Item(I).Value)
Next
GetRegExp = Array(MatchesValues, MatchesBeginIndexes, MatchesEndIndexes, TotalMatches)
End Function
Function Block(Path)
Dim BlockPaths, BeginBlockIndex, EndBlockIndex, BlockPath
BlockPaths = Filter(TreePaths, "/" & Path & "/*")
If ((UBound(BlockPaths) - LBound(BlockPaths)) <> 1) Then
Set Block = Nothing
Else
BlockPath = BlockPaths(0)
BeginBlockIndex = CLng(Mid(BlockPath, InStr(BlockPath, ":") + 1))
BlockPath = BlockPaths(1)
EndBlockIndex = CLng(Mid(BlockPath, InStr(BlockPath, ":") + 1))
Dim TemplateBlock
Set TemplateBlock = New clsTemplateBlock
Set TemplateBlock.Template = Me
With TemplateBlock
.Path = Path
.BeginOfBlock = BeginBlockIndex
.EndOfBlock = EndBlockIndex
End With
Set Block = TemplateBlock
End If
End Function
End Class
Class clsTemplateBlock
Public Template
Public Path
Public BeginOfBlock
Public EndOfBlock
Sub SetVar(VariableName, Value)
Template.SetVar Path & "/" & VariableName, Value
End Sub
Sub Clear()
Template.SetVar Path, ""
End Sub
Property Let HTML(NewValue)
Template.SetBlockHTML Me, NewValue
End Property
Function GetVar(VariableName, Value)
GetVar = Template.GetVar(Path & "/" & VariableName)
End Function
Sub Show()
Template.ParseBlockByIndex BeginOfBlock, EndOfBlock, False
End Sub
Sub Parse(Accumulate)
Template.ParseBlockByIndex BeginOfBlock, EndOfBlock, Accumulate
End Sub
Sub PParse(Accumulate)
Template.PParse Path, Accumulate
End Sub
Sub ParseTo(Accumulate, TargetBlock)
Template.ParseTo Path, Accumulate, TargetBlock.Path
End Sub
Function BlockExists(BlockName, BlockType)
BlockExists = Template.BlockExists(Path & "/" & BlockName, BlockType)
End Function
Function Block(NewPath)
Set Block = Template.Block(Path & "/" & NewPath)
End Function
Property Get Variable(VarName)
Variable = Template.GetVar(Path & "/@" & VarName)
End Property
Property Let Variable(VarName, NewValue)
Template.SetVar Path & "/@" & VarName, NewValue
End Property
Property Let Visible(Value)
If Value Then
Template.Parse Path, False
Else
Template.SetVar Path, ""
End If
End Property
End Class
'End Template class
%>