Option Strict On Option Explicit On Imports System.Text ''' ''' Helper class to return the cleaned rtf, especcially the merge fields ''' to be clean and replaced by their values. Keep in mind: ''' 1. NO PIPES (|) allowed in the merge field(they will be removed) !!! ''' 2. ALL SPACES will be removed ''' Public Class RTFMergeFieldCleaner Private _ArrayOfFields(,) As String ''' ''' Returns array of uncleaned (0st dimension 1) and cleaned (1st dimension 1) strings ''' Public ReadOnly Property ArrayOfFields() As String(,) Get Return _ArrayOfFields End Get End Property ''' ''' Returns the amount of millisecconds it took to clean the page from strange rtf tags ''' Public ReadOnly Property MilliseccondsItTookToProcess() As Integer Get Return processedinmillisecconds End Get End Property 'onderstaande is essentieel om de volgende instantie van een merge field te vinden 'houdt enkel bij waar de search was in het document Private bcounter As Integer 'om de waarde om te slaan Dim processedinmillisecconds As Integer ''' ''' Input string or stringbuilder. Returns cleaned(everything within ''' the tags is cleaned from rtf codes)string or stringbuilder ''' On failure or no start and end tag combination it will return an ''' empty string or stringbuilder or a mangled one :-) ''' Public Function CleanDocument(ByVal rtfSring As String, Optional ByVal detectStartChar As Char = CChar("["), Optional ByVal detectEndChar As Char = CChar("]")) As String Dim time As Integer = Date.Now.TimeOfDay.Milliseconds Dim sb As New StringBuilder(rtfSring) Dim sbclean As New StringBuilder(sb.ToString) Dim tempstr(1) As String Dim stepper As Integer = 0 Do tempstr = ReturnNextRtfString(sb, detectStartChar, detectEndChar, True) 'als de return leeg is exit, dit implicdeert dat er geen start tag was gevonden If tempstr(0) Is Nothing Then Exit Do sbclean.Replace(tempstr(0), tempstr(1)) 'array opbouwen met de velden evt groter maken ReDim Preserve _ArrayOfFields(1, stepper) _ArrayOfFields(0, stepper) = tempstr(0) _ArrayOfFields(1, stepper) = tempstr(1) stepper += 1 Loop processedinmillisecconds = Date.Now.TimeOfDay.Milliseconds - time Return sbclean.ToString End Function ' overload van de vorige alleen nu met een string builder Public Function CleanDocument(ByRef sb As StringBuilder, Optional ByVal detectStartChar As Char = CChar("["), Optional ByVal detectEndChar As Char = CChar("]")) As StringBuilder Dim time As Integer = Date.Now.TimeOfDay.Milliseconds Dim sbclean As New StringBuilder(sb.ToString) Dim stepper As Integer = 0 Dim tempstr(1) As String Do tempstr = ReturnNextRtfString(sb, detectStartChar, detectEndChar, True) If tempstr(0) Is Nothing Then Exit Do sbclean.Replace(tempstr(0), tempstr(1)) ReDim Preserve _ArrayOfFields(1, stepper) _ArrayOfFields(0, stepper) = tempstr(0) _ArrayOfFields(1, stepper) = tempstr(1) stepper += 1 Loop processedinmillisecconds = Date.Now.TimeOfDay.Milliseconds - time Return sbclean End Function ''' ''' Returns the next rtf string with the start and end tags. ''' optional define other start and end tags, and defin if the sting gets cleaned ''' Private Function ReturnNextRtfString(ByRef sb As StringBuilder, ByVal startchar As Char, ByVal endchar As Char, Optional ByVal autoclean As Boolean = False) As String() Dim startcounter, endcounter As Integer Dim acounter As Integer Dim returnstring(1) As String ' loop door de hele stringbuilder vanaf het startpunt For acounter = bcounter To sb.Length - 1 'zoek begin If sb.Chars(acounter) = startchar Then startcounter = acounter End If 'zoek einde If sb.Chars(acounter) = endchar Then endcounter = acounter + 1 'set nieuwe start voor de volgende aanroep van de functie bcounter = acounter + 1 End If 'retourneer de substring If startcounter > 0 AndAlso endcounter > startcounter Then 'als auto clean dan meteen schoonmaken If autoclean = True Then returnstring(1) = CleanRtfString(sb.ToString.Substring(startcounter, endcounter - startcounter)) returnstring(0) = sb.ToString.Substring(startcounter, endcounter - startcounter) Return returnstring Else returnstring(0) = sb.ToString.Substring(startcounter, endcounter - startcounter) Return returnstring End If Exit Function End If Next Return returnstring End Function ''' ''' Removes anny rtf codes between the tags leaving the strue string as return ''' allso it removes spaces(32) and pipes(|) ''' internally it replaces everything it does not know by pipes thats why :-) ''' ''' Private Function CleanRtfString(ByRef rtfstring As String) As String Dim sb As New StringBuilder(rtfstring) Dim cleansb As New StringBuilder Dim ccounter As Integer For ccounter = 0 To sb.Length 'verwijderen van dit soort strings \af0\afs20 en { } 'als geen leesteken onder de 32 ascii nummer dan weg If Asc(sb.Chars(ccounter)) > 32 AndAlso sb.Chars(ccounter) <> "|" AndAlso sb.Chars(ccounter) <> "\" AndAlso sb.Chars(ccounter) <> "{" AndAlso sb.Chars(ccounter) <> "}" Then cleansb.Append(sb.Chars(ccounter)) End If 'als we er overheen zijn dan pleite! If ccounter + 1 >= sb.Length Then Exit For ' ff al het andre wordt genegeerd en omgezet in een pipe(|) If sb.Chars(ccounter + 1) = "\" OrElse sb.Chars(ccounter + 1) = "{" OrElse sb.Chars(ccounter + 1) = "}" Then For dcounter As Integer = ccounter + 1 To sb.Length - 1 If sb.Chars(dcounter) = CChar(" ") Then Exit For sb.Chars(dcounter) = CChar("|") Next End If Next 'alle pipes weg en retourneren cleansb.Replace("|", "") Return cleansb.ToString End Function End Class