Attribute VB_Name = "lib_printF"
'-------------------------------------------------------------------------------
'File         : lib_printF.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/wikka/vbaPrintF
'Environment  : VBA XP - 2010
'Version      : 2.0.0
'Name         : PrintF
'Author       : Stefan Erb (ERS)
'History      : 04.04.2013 - 1.0.0 - ERS - Creation
'               ...
'               13.10.2014 - 1.7.0 - ERS - Code umgestellt. Properties eingefügt, cRegExp eingefügt
'               31.10.2014 - 2.0.0 - ERS - Rundumerneuert
'
'Description  : Aus der PHP-Doku:
'               - An optional sign specifier that forces a sign (- or +) to be used on a number. By default, only the - sign is used on a number if it's negative.
'                 This specifier forces positive numbers to have the + sign attached as well, and was added in PHP 4.3.0.
'               - An optional padding specifier that says what character will be used for padding the results to the right string size. This may be a space character or a 0
'                 (zero character). The default is to pad with spaces. An alternate padding character can be specified by prefixing it with a single quote (')
'               - An optional alignment specifier that says if the result should be left-justified or right-justified. The default is right-justified; a - character
'                 here will make it left-justified.
'               - An optional number, a width specifier that says how many characters (minimum) this conversion should result in.
'               - An optional precision specifier in the form of a period (`.') followed by an optional decimal digit string that says how many decimal digits
'                 should be displayed for floating-point numbers. When using this specifier on a string, it acts as a cutoff point, setting a maximum character
'                 limit to the string.
'
'               A type specifier that says what type the argument data should be treated as. Possible types:
'                   % - a literal percent character. No argument is required.
'                   //b - the argument is treated as an integer, and presented as a binary number.
'                   c - the argument is treated as an integer, and presented as the character with that ASCII value.
'                   d - the argument is treated as an integer, and presented as a (signed) decimal number.
'                   e - the argument is treated as scientific notation (e.g. 1.2e+2). The precision specifier stands for the number of digits after the decimal point
'                   E - like %e but uses uppercase letter (e.g. 1.2E+2).
'                   u - the argument is treated as an integer, and presented as an unsigned decimal number.
'                   f - the argument is treated as a float, and presented as a floating-point number (locale aware).
'                   //F - the argument is treated as a float, and presented as a floating-point number (non-locale aware). Available since PHP 4.3.10 and PHP 5.0.3.
'                   g - shorter of %e and %f.
'                   G - shorter of %E and %f.
'                   o - the argument is treated as an integer, and presented as an octal number.
'                   s - the argument is treated as and presented as a string.
'                   x - the argument is treated as an integer and presented as a hexadecimal number (with lowercase letters).
'                   X - the argument is treated as an integer and presented as a hexadecimal number (with uppercase letters).
'
'               Zusätzlich noch die Formatierungen analog http://www.freevbcode.com/ShowCode.asp?ID=5014
'               Um einen davon nicht zu parsen einfach mit einem \ marieren: '\\t' wird nicht zu Tabulator sondern zu '\t' geparst
'                   \n   Newline (Line Feed)
'                   \r   Carriage Return
'                   \t   Horizontal Tab
'-------------------------------------------------------------------------------

Option Explicit
Option Compare Database

'-----------------------------------------
'--- Public members
'-----------------------------------------
'Error: Zu wenige Werte wurden übergeben
Public Const ERR_INSUFFICIENT_PARAMS = vbObjectError - 10
'Es wird keine Zahl geliefert wo eine erwartet wird
Public Const ERR_NOT_NUMBER = vbObjectError - 11
'Das Format ist ungültig
Public Const ERR_INVALID_FORMAT = vbObjectError - 12

'-----------------------------------------
'--- Private members
'-----------------------------------------

'Die Auflistung der Submatches des geparsten Elements (Pattern D_ELEMENT_PATTERN)
Private Enum eSubElements
    emType = 0
    emFormat
    emIndex
End Enum

'Die Auflistung der Submatches des geparsten Formates (Pattern C_FORMAT_PATTERN)
Private Enum eSubFormat
    emWithSign = 0
    emFillZeroChar
    emFillChar
    emFillLength
    emInternalDecimalPlaces
End Enum

'Die sammling der Infos aus dem Pattern und der Typendefinition
Private Type tParts
    paramIndex                  As Integer
    typeS                       As String
    valueV                      As Variant      'Value als Variant, Also in Der Rohform aus dem Input
    values                      As String       'Formatierter Value als String
    format                      As String       'Das Format
    typeDef                     As String       'Typendefinition
End Type

'Infos aus dem Format
Private Type tFormat
    withSgn                     As Boolean      'Flag: das Vorzeigen immer angezeigt werden muss
    sgn                         As String       'Vorzeichen
    hasInternalDecimalPlaces    As Boolean      'Flag: hat Fixe nachkommastellen
    internalDecimalPlaces       As Integer      'Fixe Nachkommastellen
    fillChar                    As String       'Füllzeichen
    hasFillLength               As Boolean      'Flag: Hat fixe Vorkommalänge
    fillLength                  As Integer      'Fixe Vorkommalänge
End Type

'-----------------------------------------
'--- Public Methodes
'-----------------------------------------

'/**
' * Parse einen String mit Werten
' * @param  <String>        Zu formatierender String
' * @param  <Variant>*      die dazugehörigen Werte
' * @return <String>
' */
Public Function sPrintF(ByVal iFormatString As String, ParamArray iParams() As Variant) As String
On Error GoTo Err_Handler
    
    If UBound(iParams) = -1 Then
        sPrintF = replaceFormat(iFormatString)
    Else
        sPrintF = vsPrintF(iFormatString, CVar(iParams))
    End If

Exit_Handler:
On Error Resume Next
    Exit Function
Err_Handler:
    Call Err.Raise(Err.Number, "sPrintF." & Err.SOURCE, Err.Description, Err.helpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Function


'/**
' * Parse einen String mit den Werten als Array.
' * @param  <String>         Zu formatierender String
' * @param  Array<Variant>   die dazugehörigen Werte
' * @return <String>
' */
Public Function vsPrintF(ByVal iFormatString As String, ByRef iParams As Variant) As String
On Error GoTo Err_Handler

    Dim params      As Variant: params = IIf(IsArray(iParams), iParams, Array(iParams))

    'Formatedefinitionen /t /n etc ausführen
    'Der String muss nachher umgedreht werden, da VBA RegExp kein (?>!..) kennt
    vsPrintF = StrReverse(replaceFormat(iFormatString))

    'Wenn keine Parameters angegeben sind, dann beenden
    If UBound(params) = -1 Then GoTo Exit_Handler

    'Prüfen ob Formatdefinitionen im String gefunden wurden
    If Not rxElement.test(vsPrintF) Then GoTo Exit_Handler
    'String parsen
    Dim matches As Object: Set matches = rxElement.execute(vsPrintF)

    Dim i  As Integer: For i = 0 To matches.count - 1
        Dim ma As Object: Set ma = matches.item(i)
        Dim pParts As tParts: With pParts
            'Werte aus dem Pattern auslesen
            'Der Index aus dem Pattern oder die Position im String
            .paramIndex = IIf(NZ(ma.subMatches(emIndex), Empty) = Empty, i, ma.subMatches(emIndex) - 1)
            'Formatdefinitionen aus dem Pattern
            .format = StrReverse(NZ(ma.subMatches(emFormat)))
            .typeS = ma.subMatches(emType)
            'Werte der Typendefinitione übernehmen
            .typeDef = typeDefs(.typeS)
            'Prüfen ob zu dem ermittelten Index auch ein Parameterwert exisitiert
            If .paramIndex > UBound(params) Then Call Err.Raise(ERR_INSUFFICIENT_PARAMS, , "Not enough values für (v)sprintf(). ")
            'unformatierten Wert aus den Parametern auslsen
            .valueV = params(.paramIndex)
            'Parsen und Formatieren.
            Select Case .typeDef
                Case "SPEZIAL":     Call parseSpezial(pParts)
                Case "NUMBER":      Call parseNumber(pParts)
                Case "STRING":      Call parseString(pParts)
            End Select
        End With

        'Nur das erste Vorkomnis des patterns ersetzen
        vsPrintF = Replace(vsPrintF, matches.item(i).value, StrReverse(pParts.values), , 1)
    Next i

Exit_Handler:
On Error Resume Next
    vsPrintF = StrReverse(vsPrintF)
    Set ma = Nothing
    Set matches = Nothing
    Exit Function
Err_Handler:
    Call Err.Raise(Err.Number, "vsPrintF." & Err.SOURCE, Err.Description, Err.helpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Function

'-----------------------------------------
'--- Private Properties/Cache
'-----------------------------------------
'/**
' * RegExp um die einzelnen Elemente aus dem Pattern zu extrahieren
' * 0: Type
' * 1: Format
' * 2: Item Nummer
' * @return RegExp
' */
Private Property Get rxElement() As Object
    Static pCacheRegexElement As Object
    If pCacheRegexElement Is Nothing Then Set pCacheRegexElement = cRegExp("/([scdfuoxXeEgG])([\d-\.'#]*)(?:\$(\d+)|)%(?!\\)/gm")
    Set rxElement = pCacheRegexElement
End Property

'/**
' * RegExp um die Formate zu analysieren
' * emWithSign = 0
' * emFillZeroChar
' * emFillChar
' * emFillLength
' * emInternalDecimalPlaces
' * @return RegExp
' */
Private Property Get rxFormat() As Object
    Static pCacheRegexFormat As Object
    If pCacheRegexFormat Is Nothing Then Set pCacheRegexFormat = cRegExp("/([-+]?)(?:(0)|'(.)|)([1-9]\d*|)(?:\.([0-9]+)|)/gm")
    Set rxFormat = pCacheRegexFormat
End Property

'/**
' * Typendefinition
' * @return Dictionary
' */
Private Property Get typeDefs()
    Static pCacheTypeDefs As Object
    If pCacheTypeDefs Is Nothing Then
        Set pCacheTypeDefs = CreateObject("scripting.Dictionary")
        With pCacheTypeDefs
            .RemoveAll
    
            'Die verschiedenen Typendefinitionen laden
            .add "s", "STRING"              's - the argument is treated as and presented as a string.
            .add "d", "NUMBER"              'd - the argument is treated as an integer, and presented as a (signed) decimal number.
            .add "f", "NUMBER"              'f - the argument is treated as a float, and presented as a floating-point number (locale aware).
            .add "u", "NUMBER"              'u - the argument is treated as an integer, and presented as an unsigned decimal number.
            .add "c", "SPEZIAL"             'c - the argument is treated as an integer, and presented as the character with that ASCII value.
            .add "o", "SPEZIAL"             'o - the argument is treated as an integer, and presented as an octal number.
            .add "x", "SPEZIAL"             'x - the argument is treated as an integer and presented as a hexadecimal number (with lowercase letters).
            .add "X", "SPEZIAL"             'X - the argument is treated as an integer and presented as a hexadecimal number (with uppercase letters).
            .add "e", "SPEZIAL"             'e - the argument is treated as scientific notation (e.g. 1.2e+2). The precision specifier stands for the number of digits after the decimal point
            .add "E", "SPEZIAL"             'E - like %e but uses uppercase letter (e.g. 1.2E+2).
            .add "g", "SPEZIAL"             'g - shorter of %e and %f.
            .add "G", "SPEZIAL"             'G - shorter of %E and %f.
        End With
    End If
    Set typeDefs = pCacheTypeDefs
End Property

'/**
' * die RegExp um die Formatierungen (\t, \n etc) zu handeln
' * @return Dictionary(RegExp => ReplaceString)
' */
Public Property Get formatDefs() As Object
    Static pCacheFormatDefs As Object
    If pCacheFormatDefs Is Nothing Then
        Set pCacheFormatDefs = CreateObject("scripting.Dictionary")
        pCacheFormatDefs.add cRegExp("/(.*[^\\])\\n(.*)/m"), "$1" & vbLf & "$2"  '\n   Newline (Line Feed)
        pCacheFormatDefs.add cRegExp("/(.*[^\\])\\r(.*)/m"), "$1" & vbCr & "$2"  '\r   Carriage Return
        pCacheFormatDefs.add cRegExp("/(.*[^\\])\\t(.*)/m"), "$1" & vbTab & "$2" '\t   Horizontal Tab
    End If
    Set formatDefs = pCacheFormatDefs
End Property

'-----------------------------------------
'--- Private Methodes
'-----------------------------------------

'/**
' * Parst Formatierungen wie \n, \t etc
' * @param  <String>        Zu formatierender String
' * @return <String>
' */
Private Function replaceFormat(ByVal iFormatString As String) As String
On Error GoTo Err_Handler

    replaceFormat = iFormatString
    Dim rx As Variant: For Each rx In formatDefs
        Do While rx.test(replaceFormat)
            replaceFormat = rx.Replace(replaceFormat, formatDefs(rx))
        Loop
    Next

Exit_Handler:
On Error Resume Next
    Exit Function
Err_Handler:
    Call Err.Raise(Err.Number, "vsPrintF." & Err.SOURCE, Err.Description, Err.helpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Function

'/*
' * Nur das preFormat wird ausgeführt. Der format-Part des Patterns wird ignoriert
' * @param <tParts>
' */
Private Sub parseSpezial(ByRef ioParts As tParts)
On Error GoTo Err_Handler
    With ioParts
        Select Case .typeS
            Case "c": .valueV = Chr(CInt(.valueV))
            Case "o": .valueV = Oct(.valueV)
            Case "x": .valueV = LCase(Hex(.valueV))
            Case "X": .valueV = UCase(Hex(.valueV))
            Case "e": .valueV = LCase(format(.valueV, "Scientific"))
            Case "E": .valueV = UCase(format(.valueV, "Scientific"))
            Case "g": .valueV = IIf(Len(".ValueV") <= Len(format(.valueV, "Scientific")), CDbl(.valueV), LCase(format(.valueV, "Scientific")))
            Case "G": .valueV = IIf(Len(".ValueV") <= Len(format(.valueV, "Scientific")), CDbl(.valueV), UCase(format(.valueV, "Scientific")))
        End Select
    End With

Exit_Handler:
On Error Resume Next
    Exit Sub
Err_Handler:
    Call Err.Raise(Err.Number, "parseSpezial." & Err.SOURCE, Err.Description, Err.helpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Sub

'/*
' * Parse a Number
' * @param <tParts>
' */
Private Sub parseNumber(ByRef ioParts As tParts)
    Dim formatS     As String
    Dim fd          As tFormat
On Error GoTo Err_Handler

    With ioParts
        If Not IsNumeric(.valueV) Then Call Err.Raise(ERR_NOT_NUMBER, , "Parameter is not a Number")
        Select Case .typeS
            Case "d":   .valueV = CLng(.valueV)
            Case "f":   .valueV = CDbl(.valueV)
            Case "u":   .valueV = Abs(CInt(.valueV))
        End Select
        'Wenn kein Format definiert ist, einfach die Variable un
        .values = CStr(.valueV)
        If Not .format = vbNullString Then

            'Formatdetails auselsen
            fd = parseFormat(.format, 0)

            If fd.hasFillLength Then formatS = str_repeat("0", fd.fillLength)
            If fd.hasInternalDecimalPlaces Then
                If fd.internalDecimalPlaces > 0 Then formatS = formatS & "." & str_repeat("0", fd.internalDecimalPlaces)
            Else
                If .valueV <> Fix(.valueV) Then
                    formatS = formatS & "." & str_repeat("#", Len(.valueV - Fix(.valueV)))
                End If
            End If
            If fd.withSgn Then formatS = "+" & formatS & ";-" & formatS

            .values = format(.valueV, formatS)

        End If
    End With

Exit_Handler:
On Error Resume Next
    Exit Sub
Err_Handler:
    Call Err.Raise(Err.Number, "parseNumber." & Err.SOURCE, Err.Description, Err.helpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Sub

'/*
' * Parse a String
' * @param <tParts>
' */
Private Sub parseString(ByRef ioParts As tParts)
    Dim fd   As tFormat
On Error GoTo Err_Handler

    With ioParts

        ' '-Zeichen im Text markieren
        .valueV = Replace(CStr(.valueV), "'", "''")
        'Wenn kein Format definiert ist, einfach die Variable un
        .values = CStr(.valueV)
        If Not .format = vbNullString Then

            'Formatdetails auselsen. Die Items von fd haben die Namen von der Nummerformatierung
            fd = parseFormat(.format, " ")

            'Wenn ien Vorzeichen gesetzt ist, das ganez Rechtbündig nehmen
            'An optional alignment specifier that says if the result should be left-justified or right-justified. The default is right-justified; a - character
            'here will make it left-justified.
            If fd.sgn = "-" Then
                If fd.hasFillLength Then
                    .values = rPad(.values, fd.fillChar, fd.fillLength)
                End If
                If fd.hasInternalDecimalPlaces Then
                    .values = Right(.values, fd.internalDecimalPlaces)
                End If
            Else
                If fd.hasFillLength Then
                    .values = lPad(.values, fd.fillChar, fd.fillLength)
                End If
                If fd.hasInternalDecimalPlaces Then
                    .values = Left(.values, fd.internalDecimalPlaces)
                End If
            End If

        End If
    End With


Exit_Handler:
On Error Resume Next
    Exit Sub
Err_Handler:
    Call Err.Raise(Err.Number, "parseString." & Err.SOURCE, Err.Description, Err.helpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Sub

'/**
' * Parst den Format-Teil des Patterns
' * @param  <String>        Formatteil
' * @param  <Variant>       Standart-Füllzeichen
' * @return <tFormat>
' */
Private Function parseFormat(ByVal iFormat As String, ByVal iDefaultFillChar As Variant) As tFormat
On Error GoTo Err_Handler

    If Not rxFormat.test(iFormat) Then Call Err.Raise(ERR_INVALID_FORMAT, , "Wrong Format '" & iFormat & "'")
    
    'Format parsen
    Dim matches As Object: Set matches = rxFormat.execute(iFormat)

    Dim subMatches  As Object: Set subMatches = matches.item(0).subMatches

    'Die einzelnen Teile auslesen und auswerten
    With parseFormat
        'Füllzeichen ermitteln
        .fillChar = subMatches(emFillZeroChar)
        If .fillChar = Empty Then .fillChar = subMatches(emFillChar)
        If .fillChar = Empty Then .fillChar = iDefaultFillChar

        'Füllänge
        .hasFillLength = subMatches(emFillLength) <> Empty
        If .hasFillLength Then .fillLength = CInt(subMatches(emFillLength))

        'Nachkommastellen
        .hasInternalDecimalPlaces = subMatches(emInternalDecimalPlaces) <> Empty
        If .hasInternalDecimalPlaces Then .internalDecimalPlaces = CInt(subMatches(emInternalDecimalPlaces))

        'Vorzeichen (bei String, Links-Rechts Bündig)
        .withSgn = subMatches(emWithSign) <> Empty
        'Das Vorzeichen selber wird so nur beim String verwendet
        .sgn = IIf(.withSgn, subMatches(emWithSign), "+")
    End With

Exit_Handler:
On Error Resume Next
    Set subMatches = Nothing
    Set matches = Nothing

    Exit Function
Err_Handler:
    Call Err.Raise(Err.Number, "parseFormat." & Err.SOURCE, Err.Description, Err.helpFile, Err.HelpContext)
    Resume Exit_Handler
    Resume
End Function

'-----------------------------------------
'--- Verwendete allgemeine Funktionen
'-----------------------------------------

'-----------------------------------------
' cDict V 2.1.0
'-----------------------------------------

'/**
' * Wandelt verschiedene Formate in ein Dictionary um
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cdict
' * @param  ParamArray
' * @return Dictionary
' */
Private Function cDict(ParamArray iItems() As Variant) As Object
    Set cDict = CreateObject("scripting.Dictionary")
    Dim items() As Variant: items = CVar(iItems)
    Dim i As Integer, KEY As Variant, value As Variant
    Dim isList As Boolean
    
    If UBound(items) = -1 Then Exit Function

    'Prüfen ob 2 Parametetrs übergeben wurden
    If UBound(items) = 1 Then
        'Beide Parametrer sind Arrays -> Combine: Erster Array Keys, 2ter Values
        If IsArray(items(0)) And IsArray(items(1)) Then
            KEY = items(0):         value = items(1)
            Dim delta As Long:      delta = LBound(KEY) - LBound(value)
            ReDim Preserve value(LBound(value) To UBound(KEY) + delta)
            For i = LBound(KEY) To UBound(KEY)
                If Not cDict.exists(KEY(i)) Then cDict.add KEY(i), value(i + delta)
            Next i
            Exit Function
        End If
    End If
    
    'Alle Items durchackern
    For i = 0 To UBound(items)
        Dim item As Variant: ref item, items(i)
        'Dictionary
        If Not isList And TypeName(item) = "Dictionary" Then
            For Each KEY In items(i).keys
                If Not cDict.exists(KEY) Then cDict.add KEY, item.item(KEY)
            Next KEY
        'einsamer Array
        ElseIf Not isList And IsArray(item) Then
            For KEY = LBound(item) To UBound(item)
                If Not cDict.exists(KEY) Then cDict.add KEY, item(KEY)
            Next KEY
        'SetString
        ElseIf Not isList And Not IsArray(item) And Not IsObject(item) Then
            If rxSetString.test(StrReverse(item)) Then
                Dim mc As Object: Set mc = rxSetString.execute(StrReverse(item))
                Dim k As Integer: For k = mc.count - 1 To 0 Step -1
                    Dim m As Object: Set m = mc(k)
                    KEY = StrReverse(firstValue(m.subMatches(6), m.subMatches(5), m.subMatches(3)))
                    value = StrReverse(firstValue(m.subMatches(2), m.subMatches(1)))
                    Select Case m.subMatches(0)
                        Case "#":   value = eval("#" & value & "#")
                        Case Empty: value = CDec(value)
                        Case Else:  value = cRegExp("/\\(['""])/g").Replace(value, "$1")
                    End Select
                    If Not cDict.exists(KEY) Then cDict.add KEY, value
                Next k
            Else
                GoTo DEFAULT        'Zuerst wollte ich diesen GoTo nicht haben. Aber StrReverse() wirft ein Fehler wenn ein Objekt übergeben wird. Darum konnte der Test nicht im ElseIf durchgeführt werden.
            End If
        'Alles andere geht in ein WertePaar.
        ElseIf i = 0 Or isList Then
DEFAULT:
            If i Mod 2 = 0 Then
                KEY = item
            Else
                If Not cDict.exists(KEY) Then cDict.add KEY, item
            End If
            isList = True
        End If
    Next i
    'Falls es sich um eine nicht abgeschlossene Liste handelt
    If isList And i Mod 2 <> 0 Then
        If Not cDict.exists(KEY) Then cDict.add KEY, Empty
    End If
End Function

'-------------------------------------------------------------------------------
'-- Private methodes / properties for cDict()
'-------------------------------------------------------------------------------
'/**
' * Gibt den ersten Wert zurück, der nicht Nothing, Empty oder Null ist
' * @param  ParamArray
' * @return Variant
' */
Private Function firstValue(ParamArray items() As Variant) As Variant
    For Each firstValue In items
        If IsObject(firstValue) Then
            If Not firstValue Is Nothing Then Exit For
        Else
            If Not IsNull(firstValue) And Not firstValue = Empty Then Exit For
        End If
    Next
End Function

'/**
' * Gibt eine Refernez auf den Wert zurück
' * @param  Variant     Variable, di abgefüllt werden soll
' * @param  Variant     Value
' */
Private Sub ref(ByRef oItem As Variant, Optional ByRef iItem As Variant)
    If IsMissing(iItem) Then
        oItem = Empty
    ElseIf IsObject(iItem) Then
        Set oItem = iItem
    Else
        oItem = iItem
    End If
End Sub

'/**
' * Handelt den RegExp-Cache um ein Set-String zu zerlegen
' * @return RegExp
' */
Private Property Get rxSetString() As Object
    Static rxCachedSetString As Object
    If rxCachedSetString Is Nothing Then
        Set rxCachedSetString = CreateObject("VBScript.RegExp")
        rxCachedSetString.Global = True
        rxCachedSetString.pattern = "(?:(['""#])(?!\\)(.+?)\1(?!\\)|([0-9\.]+?))\s*(?:>=|[:=])\s*(?:\]([^\[]+)\[|(['""])(?!\\)(.+?)\5(?!\\)|(\w+))"
    End If
    Set rxSetString = rxCachedSetString
End Property

'-------------------------------------------------------------------------------
'-- cRegExp()
'-------------------------------------------------------------------------------
'/**
' * Erstellt ein RegExp-Object mit den Grundeinstellungen
' * V2.0.0
' * @param  String          Pattern analog RegExp
' * @param  rxpFlagsEnum    Eigenschaften von Regexp. Global, IgnoreCase und Multiline.
' *                         Die Eigenschaften können mit + kombiniert werden
' * @return RegExp
' */
Private Function cRegExp(ByVal iPattern As String) As Object
    Static rxCachedPattern As Object
    If rxCachedPattern Is Nothing Then
        Set rxCachedPattern = CreateObject("VBScript.RegExp")
        rxCachedPattern.pattern = "^([@&!/~#=\|])(.*)\1([igm]{0,3})$"
    End If
    Dim parts As Object: Set parts = rxCachedPattern.execute(iPattern)(0).subMatches
    Set cRegExp = CreateObject("VBScript.RegExp")
    cRegExp.pattern = parts(1)
    cRegExp.IgnoreCase = parts(2) Like "*i*"
    cRegExp.Global = parts(2) Like "*g*"
    cRegExp.Multiline = parts(2) Like "*m*"
End Function

'http://support.microsoft.com/kb/96458
 '=====================================================================
   'The following function will left pad a string with a specified
   'character. It accepts a base string which is to be left padded with
   'characters, a character to be used as the pad character, and a
   'length which specifies the total length of the padded result.
 '=====================================================================
Private Function lPad(ByVal MyValue$, ByVal MyPadCharacter$, ByVal MyPaddedLength%)
Dim x As Integer
   Dim PadLength As Integer

      PadLength = MyPaddedLength - Len(MyValue)
      Dim PadString As String
      For x = 1 To PadLength
         PadString = PadString & MyPadCharacter
      Next
      lPad = PadString + MyValue

End Function
 '=====================================================================
   'The following function will right pad a string with a specified
   'character. It accepts a base string which is to be right padded with
   'characters, a character to be used as the pad character, and a
   'length which specifies the total length of the padded result.
 '=====================================================================
Private Function rPad(ByVal MyValue$, ByVal MyPadCharacter$, ByVal MyPaddedLength%)
Dim x As Integer
   Dim PadLength As Integer

      PadLength = MyPaddedLength - Len(MyValue)
      Dim PadString As String
      For x = 1 To PadLength
         PadString = MyPadCharacter & PadString
      Next
      rPad = MyValue + PadString

End Function

'/**
' * Wiederholt einen String
' * http://wiki.yaslaw.info/wikka/vbvbaStringFunctions
' * @param  String   zu wiederholender String
' * @param  Integer  Anzahl weiderholungen
' * @return String   Resultat
' */
Private Function str_repeat(ByVal str As String, ByVal multiplier As Integer) As String
    Dim i As Integer

    For i = 1 To multiplier
        str_repeat = str_repeat & str
    Next i
End Function