Nuvolar/Nuvolar.Module.Win/Editor/RichTextEditor/RichEditHandler.vb

Option Strict On
Option Explicit On

Imports System.Text

''' <summary>
''' 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
''' </summary>
Public Class RTFMergeFieldCleaner
    Private _ArrayOfFields(,) As String
    ''' <summary>
    ''' Returns array of uncleaned (0st dimension 1) and cleaned (1st dimension 1) strings
    ''' </summary>
    Public ReadOnly Property ArrayOfFields() As String(,)
        Get
            Return _ArrayOfFields
        End Get
    End Property
    ''' <summary>
    ''' Returns the amount of millisecconds it took to clean the page from strange rtf tags
    ''' </summary>
    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
    ''' <summary>
    ''' 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 :-)
    ''' </summary>
    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
    ''' <summary>
    ''' 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
    ''' </summary>
    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
    ''' <summary>
    ''' 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 :-)
    ''' </summary>
    ''' <remarks></remarks>
    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