Public Function ParseText( _
ByVal TextToParse As String, _
ByVal ParseStartDelim As Char, _
ByVal ParseEndDelim As Char, _
ByVal ClassCollection As Collection, _
Optional ByVal ClassFieldSeparator As Char = ".", _
Optional ByVal DebugMode As Boolean = False, _
Optional ByVal DebugEndBlockPrefix As Char = "/", _
Optional ByVal StartTag As String = "[template start]", _
Optional ByVal EndTag As String = "[template end]") _
As String
'For use with web pages that need data access
'
'Parses text based on start and end delim char. Uses CallByName to determine
'what to replace parsed values with. Debug mode helps make debuging final
'output easier.
'Assuming that ClassCollection has an item that is a class with a field named
''name' that was set to 'Jack Schitt' and said item's Key in the collection
'was 'Profile'. Also assume 'ParseStartDelim', 'ParseEndDelim',
''ClassFieldSeperator' and are '[', ']', and '.', respectivly, then the
'samples can be shown as:
'
'"test test [profile.name] test"
'
'With DebugMode=False, this function would return
'"test test Jack Schitt test"
'
'With DebugMode=True, this function would return
'"test test [profile.name]Jack Schitt[/profile.name] test"
'
'Classes and/or members that don't exist raise an exception that is trapped
'internally, causeing the tag to be replaced with "". (This is useful for
'comments.) In debug mode, it will be replaced by the message of the exception.
'
'Last but not least, there are the 'StartTag' and 'EndTag' params. Basically,
'only text between those tags is returned. Text outside of those tags is
'removed prior to parsing.
Dim Pos As Integer 'current position in string
Dim SubStringHolder As String 'Holds a substring between a particular [ and ]
' [ is shorthand for ParseStartDelim
' (and viceversa)
Dim ClassName As String
Dim FieldName As String
Dim [Class] As Object
Dim ReturnValue As Object
'check for start tag
If TextToParse.IndexOf(StartTag) <> -1 Then
'remove everything before [template start]
TextToParse = TextToParse.Remove(0, TextToParse.IndexOf(StartTag) + StartTag.Length)
End If
'check for end tag
If TextToParse.IndexOf(EndTag) <> -1 Then
'remove everything after end tag
TextToParse = TextToParse.Remove(TextToParse.IndexOf(EndTag), TextToParse.Length - TextToParse.IndexOf(EndTag))
End If
While Pos < (TextToParse.Length)
'if [character at Pos] = ParseStartDelim
'...The complicated, but efficient way...
If (TextToParse.Substring(Pos, 1).Chars(0).Equals(ParseStartDelim)) Then
'In Tag
Try
'we need the substring from the current [ to the next ]
'get everything from Pos on
SubStringHolder = TextToParse.Substring(Pos + 1)
'trim it to the next ]
If SubStringHolder.IndexOf(ParseEndDelim) = -1 Then
Throw New ParseException("Reached end of file without closing delimiter.", True)
End If
SubStringHolder = SubStringHolder.Substring(0, SubStringHolder.IndexOf(ParseEndDelim))
'remove the existing text
TextToParse = TextToParse.Remove(Pos, SubStringHolder.Length + 2)
If SubStringHolder.IndexOf(ClassFieldSeparator) = -1 Then
'contains no '.'
ClassName = SubStringHolder
Throw New ParseException("No class name specified", False)
End If
ClassName = SubStringHolder.Substring(0, SubStringHolder.IndexOf(ClassFieldSeparator))
FieldName = SubStringHolder.Substring(SubStringHolder.IndexOf(ClassFieldSeparator) + 1)
If ClassName = "" Then
'[.foo]
Throw New ParseException("No class name specified", False)
End If
If FieldName = "" Then
'[foo.]
Throw New ParseException("No field name specified", False)
End If
[Class] = ClassCollection(ClassName)
ReturnValue = CallByName([Class], FieldName, CallType.Get)
'this next block is required incase field is a sub or
'otherwise doesn't return a value
If ReturnValue Is Nothing Then
If DebugMode Then
SubStringHolder = "Field was called but returned 'Nothing'"
Else
SubStringHolder = ""
End If
Else
SubStringHolder = ReturnValue.ToString
End If
Catch nope As MissingMemberException
'CallByName throws this.
'[foo.bar] 'bar' is not found
If DebugMode Then
SubStringHolder = "Field name not found"
Else
SubStringHolder = ""
End If
Catch nope As ArgumentException
'[Class] = ClassCollection(ClassName) throws this
'[foo.bar] 'foo' not found in collection
If DebugMode Then
SubStringHolder = "Class name not found"
Else
SubStringHolder = ""
End If
Catch nope As ParseException
'Several If...Then blocks above throw this
If DebugMode Then
SubStringHolder = nope.Message
Else
SubStringHolder = ""
End If
If nope.IsFatal Then
Return TextToParse & " " & SubStringHolder
Exit Function
End If
Finally
If DebugMode Then
'if debug mode, wrap the string with tags
'[foo.bar]{value}
SubStringHolder = ParseStartDelim & _
ClassName & ClassFieldSeparator & FieldName & _
ParseEndDelim & SubStringHolder
'+=[/foo.bar]
SubStringHolder += ParseStartDelim & DebugEndBlockPrefix & _
ClassName & ClassFieldSeparator & FieldName & _
ParseEndDelim
End If
End Try
'insert the value into the main text where the tag originally
'was. if DebugMode, the tags were wrapped above.
TextToParse = TextToParse.Insert(Pos, SubStringHolder)
'increment the position by the length of the new value. -1 for
'the statement after this one
Pos += SubStringHolder.Length - 1
End If
Pos += 1
If Pos < 0 Then Exit While
End While
Return TextToParse
End Function
Public Class ParseException
'this exception used internally by the parser
'
''message' is the text sent to the output when the parser's
''debugmode' is true
'
''IsFatal' tells the parser to stop parseing. If true, ''Message' is
'appended to the end of the output.
Inherits Exception
Sub New(ByVal message As String, ByVal IsFatal As Boolean)
MyBase.New(message)
_IsFatal = IsFatal
End Sub
Private _IsFatal As Boolean 'private copy
Public ReadOnly Property IsFatal() As Boolean
Get
Return _IsFatal
End Get
End Property
End Class
Reply With Quote