Class Template
Private m_FileName m_Root m_Unknowns m_LastError m_HaltOnErr
Private m_ValueList m_BlockList
Private m_RegExp
Private Sub Class_Initialize
Set m_ValueList = CreateObject("ScriptingDictionary")
Set m_BlockList = CreateObject("ScriptingDictionary")
set m_RegExp = New RegExp
m_RegExpIgnoreCase = True
m_RegExpGlobal = True
m_FileName = ""
m_Root = ""
m_Unknowns = "remove"
m_LastError = ""
m_HaltOnErr = true
End Sub
Private Sub Class_Terminate
Set m_RegExp = Nothing
Set m_BlockMatches = Nothing
Set m_ValueMatches = nothing
End Sub
Public Property Get ClassName()
ClassName = "Template"
End Property
Public Property Get Version()
Version = ""
End Property
Private Function LoadFile(ByVal chartype)
Dim Filename fso hndFile
Filename = m_Root
If Right(Filename )<>"/" And Right(Filename )<>"" Then Filename = Filename & "/"
Filename = ServerMapPath(Filename & m_FileName)
Set StreamObject = ServerCreateObject("AdodbStream")
StreamObjectType =
StreamObjectMode =
StreamObjectOpen
StreamObjectPosition =
StreamObjectLoadFromFile Filename
StreamObjectPosition =
StreamObjectType =
StreamObjectCharSet = chartype
LoadFile = StreamObjectreadtext()
If LoadFile = "" Then ShowError("x<br>Could Not Load The File " & m_FileName & "!")
End Function
Private Sub ShowError(ByVal msg)
m_LastError = msg
ResponseWrite "<span style=""fontsize:px;color:red"">Error ID : " & msg & "</span>"
If m_HaltOnErr Then ResponseEnd
End Sub
Public Sub set_root(ByVal Value)
m_Root = Value
End Sub
Public Function get_root()
get_root = m_Root
End Function
Public Property Let Root(ByVal Value)
set_root(Value)
End Property
Public Property Get Root()
Root = m_Root
End Property
Public Sub set_file(ByVal handleByVal filenameByVal chartype)
m_FileName = filename
m_BlockListAdd Handle LoadFile(chartype)
End Sub
Public Function get_file()
get_file = m_FileName
End Function
Public Sub set_unknowns(ByVal unknowns)
m_Unknowns = unknowns
End Sub
Public Function get_unknowns()
get_unknowns = m_Unknowns
End Function
Public Property Let Unknowns(ByVal unknown)
m_Unknowns = unknown
End Property
Public Property Get Unknowns()
Unknowns = m_Unknowns
End Property
Public Sub set_block(ByVal Parent ByVal BlockTag ByVal Name)
Dim Matches
m_RegExpPattern = "<!s+BEGIN " & BlockTag & "s+>([sS]*)<!s+END " & BlockTag & "s+>"
If Not m_BlockListExists(Parent) Then ShowError("x<br>Undefined Block Tag " & Parent & "!")
set Matches = m_RegExpExecute(m_BlockListItem(Parent))
For Each Match In Matches
m_BlockListAdd BlockTag MatchSubMatches()
m_BlockListItem(Parent) = Replace(m_BlockListItem(Parent) MatchValue "{" & Name & "}")
Next
set Matches = nothing
End Sub
Public Sub set_var(ByVal Name ByVal Value ByVal AppEnd)
Dim Val
If IsNull(Value) Then Val = "" Else Val = Value
If m_ValueListExists(Name) Then
If AppEnd Then m_ValueListItem(Name) = m_ValueListItem(Name) & Val _
Else m_ValueListItem(Name) = Val
Else
m_ValueListAdd Name Value
End If
End Sub
Public Sub unset_var(ByVal Name)
If m_ValueListExists(Name) Then m_ValueListRemove(Name)
End Sub
Private Function InstanceValue(ByVal BlockTag)
Dim keys i
InstanceValue = m_BlockListItem(BlockTag)
keys = m_ValueListKeys
For i= To m_ValueListCount
InstanceValue = Replace(InstanceValue "{" & keys(i) & "}" m_ValueListItem(keys(i)))
Next
End Function
Public Sub parse(ByVal Name ByVal BlockTag ByVal AppEnd)
If Not m_BlockListExists(BlockTag) Then ShowError("x<br>Undefined Block Tag " & Parent & "!")
If m_ValueListExists(Name) Then
If AppEnd Then m_ValueListItem(Name) = m_ValueListItem(Name) & InstanceValue(BlockTag) _
Else m_ValueListItem(Name) = InstanceValue(BlockTag)
Else
m_ValueListAdd Name InstanceValue(BlockTag)
End If
End Sub
Private Function finish(ByVal content)
Select Case m_Unknowns
Case "keep" finish = content
Case "remove"
m_RegExpPattern = "{[^ trn}]+}"
finish = m_RegExpReplace(content "")
Case "comment"
m_RegExpPattern = "{([^ trn}]+)}"
finish = m_RegExpReplace(content "<! Template Variable $ Undefined >")
Case Else finish = content
End Select
End Function
Public Sub output(ByVal Name)
If Not m_ValueListExists(Name) Then ShowError("x<br>Could Not Find Tag " & Name & "!")
ResponseWrite(finish(m_ValueListItem(Name)))
End Sub
End Class
