VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "JSF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : JSF.cls
'               http://wiki.yaslaw.info/doku.php/vba/classes/jsf
'               All rights reserved
'Environment  : Access VBA 2007+
'Version      : 1.4.2
'Name         : JSF
'Author       : Stefan Erb (ERS)
'History      : 15.11.2018 - ERS - Creation
'               14.10.2019 - ERS - Kleiner Fehler im toString korrigiert
'               24.12.2019 - ERS - Regex zur Erkennung der Elemente verbessert
'               16.01.2020 - ERS - Modifiers hinzugefügt
'               27.05.2020 - ERS - Excel-Modifikatioen, Modifier tbl
'               29.05.2020 - ERS - modifier tbl korrigiert
'               18.06.2020 - ERS - Feler bei modifier-Params behoben. Sollte es sich um ein Wert aus dem map handeln, muss er nicht mehr kleingeschrieben sein
'-------------------------------------------------------------------------------
Option Explicit

'-------------------------------------------------------------------------------
' -- ! SETTINGS !
'-------------------------------------------------------------------------------
'MS Applikation in der die Klasse eingesetzt wird. Es gibt einige Spezifische Dinge
'Für Word etc noch nicht getestet
#Const C_ACCESS = "ACCESS"
#Const C_EXCEL = "EXCEL"
'Auswahl
#Const ms_product = C_EXCEL

' /**
' * Wenn sprintf existiert, dann kann mit $format das Format analog zu sprintf() mitgegeben werden. Ansonsten wird der $-Teil ignoriert
' * @url        http://wiki.yaslaw.info/doku.php/vba/functions/printf/index
' * @example    ?JSF().parse("#{now $To}")  -> 20181109
' * @example    ?JSF().parse("#{1.3 $.3f}") -> 1.300
' * @example    ?JSF("DUAL").parse("#{now $TO}_#{id $6d}_DATA.CSV") -> 20181109_092806_000001_DATA.CSV
' */
#Const sPrintF_exists = True

'/**
' * Wenn mein json-Modul vorhanden ist, dann kann man auch json-Strings als Paramter übergeben.
' * Achtung! Nur eindimensionale Dictionary!
' * @url        http://wiki.yaslaw.info/doku.php/vba/cast/json
' * @example    ?JSF("{nr:1,name:Yaslaw}").parse("#{name}, du hast die Nummer #{nr} ") -> Yaslaw, du hast die Nummer 1
' */
#Const json_exists = True


'Für das Logging kann log4vba verwendet werden.
'https://wiki.yaslaw.info/doku.php/vba/classes/log4vba
#Const Log4vba = True
#If Log4vba Then
    'Und die Settings dazu
    Private Const C_ERROR_LOG_SETTINGS = eprOutConsole + eprReturnAssert + eprOutMsgBox
#End If
'Mit DEBUG_MODE True wird bei Fehler der debug.assert aktiviert
Private Const DEBUG_MODE = False

Private Const C_ERR_HANDLER_DEFAULT = 1  'errMsgBox

'/**
' * @pattern    #{formel}
' * Formel:     Auf die Felder der Source kann direkt zugegriffen werden: #{company}
' *             Es können mehrere #{} Blöcke in einem Text stehen. In sich sind sie aber nicht schachtelbar
' *             Fixwerte können in vba/sql Schreibweise innerhalb der #{} geschrieben werden
' *             Alles was mit eval() ausgeführt werden, kann innerhalb der #{} stehen. Auch eigene Public Functions
' *             Für den IIF() ist auch die abgekürzte Syntax möglich #{[not] [when] ? [then] : [else]}
' *                 Das Not ist optional
' *                 Der else-Teil ist optional. Standardwert ist '': #{[when] ? [then]}
' *                 Leerzeichen innerhalb des IIF werden ignoriert: #{[when] ? [then]} == #{[when]?[then]}
' *             Anstelle von NOT ist auch der ! gültig. #{!isNull(company) ? 'Firma' & company}
' *             Für Vergleiche auf Unterschiede <> kann auch != verwendet werden
' *             Formatzeichen (\t, \n, \r) können irgendwo im Text stehen und werden geparst. Innerhalb der #{} müssen sie als Text vorhanden sein
' *
' * @example    ?JSF("TBL_DATA_COMPANY", "CID=2").parse("Welcome #{company}") -> Welcome ERB software
' * @example    ?JSF("TBL_DATA_COMPANY", "CID=2").parse("Welcome #{ucase(company)}") -> Welcome ERB SOFTWARE
' * @example    ?JSF("TBL_DATA_COMPANY", "CID=2").parse("Welcome\t\t#{ucase(company)}") -> Welcome     ERB SOFTWARE
' */


'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------

'/**
' * Paramters für die Klasse
' */
Public Enum jsfParams
    [_NA] = -1
    jsfNothing = 0
    jsfParseFormat = 2 ^ 0          'Soll \t (Tabulator) und \r (NewLine) geparst werden
    jsfRemoveNewLine = 2 ^ 1        'Zeilenumbrüche im Pattern werden ignoriert
    jsfUnixNewLine = 2 ^ 2          'Zeilenumbruch nur mit NewLine, ohne CarriageReturn
    jsfRemoveEmptyLine = 2 ^ 3      'Leere Zeilen entfernen
    jsfRichText = 2 ^ 4             'Der Pattern kommt als RichText (MS Format: vereinfachtes HTML)
    jsfTrimMultiSpaces = 2 ^ 5      'Mehrfach Leerzeichen reduzieren
    jsfTrimLines = 2 ^ 6            'Zeilen hinten und vorne von Leerzeichen befreien
    [_Default] = jsfParseFormat + jsfTrimMultiSpaces + jsfTrimLines + jsfRemoveEmptyLine
End Enum

'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------

Private pParams As jsfParams
Private pFormatPattern As String        'Falls sprintf existiert, werden im pFormatPattern das Format gespeichert
Private pModifiers As Object            'Dictionary mit den aktuellen Modifiers
Private pModifier$
Private pCriteria As String
#If Log4vba Then
    Private pLogger As Log4vba                                      'Logger
#End If

'-------------------------------------------------------------------------------
' -- Constructors
'-------------------------------------------------------------------------------

'/**
' * Logger
' * @param  Error
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' */
Private Function handleError(ByRef iError As Variant, ByVal iSourceName As String, ParamArray iValueArray() As Variant) As Variant
Dim valueArray() As Variant:  If UBound(iValueArray) > -1 Then valueArray = CVar(iValueArray)
#If Log4vba Then
    Debug.Assert Not DEBUG_MODE And pLogger.error(iError, iSourceName, valueArray)
#Else
    MsgBox "Error: " & iError.Number & vbCrLf & iError.Description
    Debug.Assert Not DEBUG_MODE
#End If
End Function


'/**
' * Erstellt ein neues Objekt und initialisiert es
' * @param  Dictionary/Recordset/TableDef/QueryDef/Iterator/Sql/TableName/QueryName/Array
' * @param  String          Einen Filter umd auf den richtigen Datensatz zu springen. Nur gültig für Recordset, TableDef und ähnliches
' * @param  jsfParams       Paramter um die Klasse zu steuern
' * @return JSF
' */
Public Function instance( _
    Optional ByRef iSource As Variant = Nothing, _
    Optional ByVal iCriteria As String, _
    Optional ByVal iParams As jsfParams = jsfParams.[_Default] _
) As JSF
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    
    Set instance = New JSF
    instance.construct iSource, iCriteria, iParams
    
End Function

'/**
' * Fügt eine Paramtertabelle zu. Eine Tabelle mit einer SPalte für die Keys und eine für die Values
' * @param  Recordset/TableDef/QueryDef/SourceName/Sql
' * @param  String          Name des Key-Feldes
' * @param  String          Name des Value-Feldes
' * @param  String          Name des Feldes, dass den vbVarType Enthält
' * @param  jsfParams       Paramter um die Klasse zu steuern
' * @return JSF
' */
Public Function instanceParamTable( _
    ByRef iSource As Variant, _
    Optional ByVal iKeyName As String = "KEY", _
    Optional ByVal iValueName As String = "VAL", _
    Optional ByVal iVarTypeName As String = "", _
    Optional ByVal iParams As jsfParams = jsfParams.[_Default] _
) As JSF
    Set instanceParamTable = New JSF
    instanceParamTable.constructParamTable iSource, iKeyName, iValueName, iVarTypeName, iParams
End Function

'/**
' * Initialisiert ein JSF-Objekt
' * @param  Dictionary/Recordset/TableDef/QueryDef/Iterator/Sql/TableName/QueryName/Array
' * @param  String          Einen Filter umd auf den richtigen Datensatz zu springen. Nur gültig für Recordset, TableDef und ähnliches
' * @param  jsfParams       Paramter um die Klasse zu steuern
' * @return JSF
' */
Public Function construct( _
    Optional ByRef iSource As Variant = Nothing, _
    Optional ByVal iCriteria As String, _
    Optional ByVal iParams As jsfParams = jsfParams.[_Default] _
) As JSF
On Error GoTo Err_Handler

    params = iParams
    pCriteria = iCriteria
        
    clearMap
    addSource iSource, iCriteria

    Set construct = Me

Exit_Handler:
    Exit Function
Err_Handler:
    handleError Err, "construct", iSource, iCriteria, iParams
    Resume Exit_Handler
    Resume
End Function

'/**
' * Fügt eine Paramtertabelle zu. Eine Tabelle mit einer SPalte für die Keys und eine für die Values
' * @param  Recordset/TableDef/QueryDef/SourceName/Sql
' * @param  String          Name des Key-Feldes
' * @param  String          Name des Value-Feldes
' * @param  String          Name des Feldes, dass den vbVarType Enthält
' * @param  jsfParams       Paramter um die Klasse zu steuern
' * @return JSF
' */
Public Function constructParamTable( _
    ByRef iSource As Variant, _
    Optional ByVal iKeyName As String = "KEY", _
    Optional ByVal iValueName As String = "VAL", _
    Optional ByVal iVarTypeName As String = "", _
    Optional ByVal iParams As jsfParams = jsfParams.[_Default] _
) As JSF
    params = iParams
    clearMap
    addParamTable iSource, iKeyName, iValueName, iVarTypeName
    Set constructParamTable = Me
End Function


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

'/**
' * Parst einen Text mit den vorhandenen Daten
' * @param  String
' * @param  jsfParams       Paramter um das Parsen zu steuern. Überschreibt für den einen Parse-Vorang die Klassenparameters
' * @return String
' */
Public Function parse(ByVal iString As String, Optional ByVal iParams As jsfParams = jsfParams.[_NA]) As String
On Error GoTo Err_Handler
    
    Dim origParams As jsfParams: origParams = params
    If Not iParams = jsfParams.[_NA] Then params = iParams
    
    Dim text As String: text = iString
    If andB(params, jsfRemoveNewLine) Then removeCarriageReturn text          'CarriageReturn (\r) entfernen
    removeEmptyTags text               'Leere Tags entfernen

    Dim textRev As String: textRev = StrReverse(text)
    removeNewLineRev textRev          'Entfernt Zeilenumbrüche
    
    
    
'    Static rxJsfRev As Object: cRxP rxJsfRev, "\}(?!\\)(?:([^\s\}]+)\$)?([^\{]*?)\{(?!\\)#(?!\\)", , True
'    Static rxJsfRev As Object: cRxP rxJsfRev, "\}(?!\\)([^\{]*?)\{(?!\\)#(?!\\)", , True
    Static rxJsfRev As Object: cRxP rxJsfRev, "\}(?!\\)(?:(\w+)\$)?\s*([^\{]*?)\{(?!\\)#(?!\\)", , True
    
    Do While rxJsfRev.test(textRev)
        Dim parts As Object: Set parts = rxJsfRev.Execute(textRev)(0).subMatches
        Dim itemRev As String: itemRev = parts(1)
        pFormatPattern = StrReverse(parts(0))
        itemRev = parseJsfRev(itemRev)
        textRev = rxJsfRev.Replace(textRev, itemRev)
    Loop
    
    parseFormatRev textRev
    text = StrReverse(textRev)
    
    removeEmptyTags text               'Leere Tags entfernen (RichText) (ausser <div></div>)
    trimLines text                     'Zielen trimmen
    removeEmptyLine text               'Leere Zeilen entfernen
    trimMultiSpaces text               'Mehrfach Leerzeichen reduzieren
    winNewLine text
    
   
Exit_Handler:
    parse = text
    params = origParams
    Exit Function
Err_Handler:
    params = origParams
    Err.Raise Err.Number, "JSF.parse", Err.Description, Err.HelpFile, Err.HelpContext
    Resume
End Function



'/**
' * Fügt ein Wert der Map zu oder überschreibt ihn
' * @param  String      Key
' * @param  Variant     Value
' * @param  Boolean     Flag ob exisiteirende Keys überschrieben werden sollen
' * @return JSF
' */
Public Function add(ByVal iKey As String, ByVal iValue As Variant, Optional ByVal iOverwrite As Boolean = True) As JSF
    Dim key1 As String, key2 As String: key1 = createKey(iKey, key2)
    If map.exists(key1) Then
        If iOverwrite Then map(key1) = iValue
    Else
        map.add key1, iValue
    End If
    If Not map.exists(key2) Then map.add key2, iValue
    Set add = Me
End Function

'/**
' * Fügt eine Source zum bestehenden Mapping hinzu
' * @param  Dictionary/Recordset/TableDef/QueryDef/Iterator/Fields/String/Array
' * @param  String      Kriterium
' * @param  Boolean     True: bestehende Keys werden überschrieben
' * @return JSF
' */
Public Function addSource(ByRef iSource As Variant, Optional ByVal iCriteria As String, Optional ByVal iOverwrite As Boolean = True) As JSF
    Dim fld As Object
    Dim i As Long
On Error GoTo Err_Handler
    If IsArray(iSource) Then
        For i = LBound(iSource) To UBound(iSource)
            add "[" & i & "]", iSource(i)
        Next i
        GoTo Exit_Handler
    End If
    
    Select Case TypeName(iSource)
        Case "Nothing"
        'Dictionary: übersetzen, damit alle Keys in Lower Case sind
        Case "Dictionary"
            Dim keys As Variant: keys = iSource.keys
            For i = 0 To UBound(keys)
                add keys(i), iSource(keys(i)), iOverwrite
            Next i
        'Recordset. Der Standard
        Case "Recordset2", "Recordset"
            'Falls Kriterien vorhanden sind, versuchen auf den Datensatz zu springen
            If iCriteria <> "" Then
                iSource.FindFirst iCriteria
                If iSource.noMatch Then
                    For Each fld In iSource.fields
                        add fld.Name, fld.value, iOverwrite
                    Next fld
                    GoTo Exit_Handler
                End If
            End If
            addSource iSource.fields, iOverwrite
        Case "Fields"
            For Each fld In iSource
                add fld.Name, fld.value, iOverwrite
            Next fld
        'Iterator
        Case "Iterator"
            Select Case TypeName(iSource.source)
                Case "Recordset2":  Set source = iSource.source
                Case Else:
                    Do While iSource.toNext
                        add iSource.key, iSource.value, iOverwrite
                    Loop
            End Select
        'QueryDef und TableDef. Den Recordset öffnen und verarbeiten
        Case "QueryDef", "TableDef":        addSource iSource.openRecordset
        Case "JSF":                         addSource iSource.map, iOverwrite
        Case "String"
            #If json_exists Then
                Dim var As Variant: ref var, json2obj(iSource)
                If TypeName(var) = "Dictionary" Then
                    addSource var, iOverwrite
                    GoTo Exit_Handler
                End If
            #End If
            #If ms_product = C_ACCESS Then
                If Not trim(LCase(iSource)) Like "select*" Then iSource = "select * from " & iSource
                addSource CurrentDb.openRecordset(iSource), iCriteria, iOverwrite
            #End If
        Case Else:                          Err.Raise 13
    End Select
    
Exit_Handler:
    Set addSource = Me
    Exit Function
    
Err_Handler:
    Select Case Err.Number
        Case 3070:              'Der Filter kann nicht angewendet werden
            Err.Raise Err.Number, "JSF.source", Err.Description
        Case Else:              'Den Fehler weiterreichen
            Err.Raise Err.Number, "JSF.source", Err.Description
    End Select
    Resume
End Function

'/**
' * Fügt eine Paramtertabelle zu. Eine Tabelle mit einer Spalte für die Keys und eine für die Values
' * @param  Recordset/TableDef/QueryDef/SourceName/Sql
' * @param  String          Name des Key-Feldes
' * @param  String          Name des Value-Feldes
' * @param  String          Name des Feldes, dass den vbVarType Enthält
' * @param  Boolean         True: bestehende Keys werden überschrieben
' * @return JSF
' */
Public Function addParamTable( _
    ByRef iSource As Variant, _
    Optional ByVal iKeyName As String = "KEY", _
    Optional ByVal iValueName As String = "VAL", _
    Optional ByVal iVarTypeName As String = "", _
    Optional ByVal iOverwrite As Boolean = True _
) As JSF
    Dim fld As Object
On Error GoTo Err_Handler
    Select Case TypeName(iSource)
        Case "Nothing"
        'Dictionary: übersetzen, damit alle Keys in Lower Case sind
        'Recordset. Daer Standard
        Case "Recordset2"
            'Falls Kriterien vorhanden sind, versuchen auf den Datensatz zu springen
            iSource.MoveFirst
            Do While Not iSource.EOF
                Dim value As Variant: value = iSource(iValueName).value
                If Not iVarTypeName = "" Then
                    Select Case iSource(iVarTypeName)
                        Case vbString: value = value
                        Case vbBoolean: value = CBool(value)
                        'Case Else: value = cVal(value)
                        Case Else: value = eval(value)
                    End Select
                End If
            Loop
        #If ms_product = C_ACCESS Then
            'QueryDef und TableDef. Den Recordset öffnen und verarbeiten
            Case "QueryDef", "TableDef"
                addParamTable iSource.openRecordset, iKeyName, iValueName, iVarTypeName, iOverwrite
            Case "String"
                If Not trim(LCase(iSource)) Like "select*" Then iSource = "select * from " & iSource
                addParamTable CurrentDb.openRecordset(iSource), iKeyName, iValueName, iVarTypeName, iOverwrite
        #End If
        Case Else:
            Err.Raise 13
    End Select
    
Exit_Handler:
    Set addParamTable = Me
    Exit Function
    
Err_Handler:
    Err.Raise Err.Number, "JSF.source", Err.Description
End Function

'/**
' * Handelt den object-Cache um ein Set-String zu zerlegen
' * @return object
' */
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

Private Function eval(ByVal iValue As String) As Variant
    Dim value As Variant: value = trim(iValue)
    Dim rx As Object: Set rx = cRx("/^(['""#])([^\1]+)\1$/")

    If rx.test(value) Then
        Dim sm As Object: Set sm = rx.Execute(value)(0).subMatches
        value = sm(1)
        Select Case sm(0)
            Case "#":   value = dateValue(value)  'eval("#" & value & "#")
            Case Empty: value = CDec(value)
        End Select
    End If
    eval = value
End Function

'/**
' * leert die Map
' * @return JSF
' */
Public Function clearMap() As JSF
    map.RemoveAll
    Set clearMap = Me
End Function

'/**
' * ersetzt ein Paramter und gibt die Instanz zurück
' * @example:   text = JSF("my_table").setParam(jsfUnixNewLine, true).parse("#{anrede} #{name}")
' * @param  jsfParams
' * @param  Boolean
' * @return JSF
' */
Public Function setParam(ByVal iParam As jsfParams, Optional ByVal iFlag As Boolean = True) As JSF
    param(iParam) = iFlag
    Set setParam = Me
End Function


'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------

'/**
' * @param  Sql/TableName/QueryName
' */
Public Property Let source(ByRef iSource As Variant)
    clearMap
    addSource iSource, pCriteria
End Property
'/**
' * @param  Dictionary/Recordset/TableDef/QueryDef/Iterator
' */
Public Property Set source(ByRef iSource As Variant)
    clearMap
    addSource iSource, pCriteria
End Property

'/**
' * @param  Dictionary<KeyLCase,Value>
' */
Public Property Get map() As Object
    Static pMap As Object: If pMap Is Nothing Then Set pMap = CreateObject("scripting.Dictionary")
    Set map = pMap
End Property

'/**
' * Paramter der Klasse
' * @param  jsfParams
' */
Public Property Get params() As jsfParams:                      params = pParams:                               End Property
Public Property Let params(iParams As jsfParams):               pParams = iParams:                              End Property

'/**
' * Soll \t, \n und \r geparst werden
' * @param  Boolean
' */
Public Property Get flagParseFormat() As Boolean:               flagParseFormat = param(jsfParseFormat):        End Property
Public Property Let flagParseFormat(ByVal iFlag As Boolean):    param(jsfParseFormat) = iFlag:                  End Property

'/**
' * Sollen Zeilenumbrüche entfernt werden
' * @param  Boolean
' */
Public Property Get flagRemoveNewLine() As Boolean:             flagRemoveNewLine = param(jsfRemoveNewLine):    End Property
Public Property Let flagRemoveNewLine(ByVal iFlag As Boolean):  param(jsfRemoveNewLine) = iFlag:                End Property

'/**
' * Leere Zeilen enternen
' * @param  Boolean
' */
Public Property Get flagRemoveEmptyLine() As Boolean:             flagRemoveEmptyLine = param(jsfRemoveEmptyLine):  End Property
Public Property Let flagRemoveEmptyLine(ByVal iFlag As Boolean):  param(jsfRemoveEmptyLine) = iFlag:                End Property

'/**
' * Der zu parsende Text ist im RichText Format
' * @param  Boolean
' */
Public Property Get flagRichText() As Boolean:                  flagRichText = param(jsfRichText):              End Property
Public Property Let flagRichText(ByVal iFlag As Boolean):       param(jsfRichText) = iFlag:                     End Property

'/**
' * Mehrfache Leerzeichen auf eines Reduzieren
' * @param  Boolean
' */
Public Property Get flagTrimMultiSpaces() As Boolean:            flagTrimMultiSpaces = param(jsfTrimMultiSpaces):   End Property
Public Property Let flagTrimMultiSpaces(ByVal iFlag As Boolean): param(jsfTrimMultiSpaces) = iFlag:                 End Property

'/**
' * Leerzeichen und Tabulatoren vor und nach jeder Zeile entfernen
' * @param  Boolean
' */
Public Property Get flagTrimLines() As Boolean:                 flagTrimLines = param(jsfTrimLines):            End Property
Public Property Let flagTrimLines(ByVal iFlag As Boolean):      param(jsfTrimLines) = iFlag:                    End Property

'/**
' * Zeilenumbruch nur mit NewLine, ohne CarriageReturn
' * @param  Boolean
' */
Public Property Get flagUnixNewLine() As Boolean:               flagUnixNewLine = param(jsfUnixNewLine):       End Property
Public Property Let flagUnixNewLine(ByVal iFlag As Boolean):    param(jsfUnixNewLine) = iFlag:                 End Property

'/**
' * Kriterum für den Recordset/Sql/TableDef/QueryDef.
' * @param  String
' */
Public Property Get criteria() As String:                       criteria = pCriteria:                           End Property
Public Property Let criteria(ByVal iCriteria As String):        pCriteria = iCriteria:                          End Property

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

'/**
' * Extrahiert die Modifier aus einem Element
' * @param  String
' * @return String
' */
Private Function extractModifiersRev(ByVal iStringRev$) As String
    extractModifiersRev = iStringRev
    'Modifiers
    Set pModifiers = CreateObject("scripting.Dictionary")
    Static rxModifiersRev As Object: cRxP rxModifiersRev, "(?:[^\|]|\|(?=\\))+?\|(?!\\)"
    Static rxModifyParamsRev As Object: cRxP rxModifyParamsRev, "(?:~([\s\S]*?)~|([^:\|]+)\b)[:=](?!\\)"
    Static rxRemoveMarker As Object: cRxP rxRemoveMarker, "\\(?!\\)", True
    
    Do While rxModifiersRev.test(extractModifiersRev)
        Dim str$: str = rxModifiersRev.Execute(extractModifiersRev)(0)
        Dim i&: i = -1
        Dim vsRev(), vs(): vsRev = Array(): vs = Array()
        
        'Parameterd auslesen
        '0->, 1->value
        Do While rxModifyParamsRev.test(str)
            i = i + 1: ReDim Preserve vsRev(i)
            Dim parts As Object: Set parts = rxModifyParamsRev.Execute(str)(0)
            vsRev(i) = StrReverse(rxRemoveMarker.Replace(parts.subMatches(0) & parts.subMatches(1), ""))
                        
            'Wert ggf mappen
            If parts.subMatches(0) = Empty And Not IsNumeric(vsRev(i)) Then
                If map.exists(LCase(vsRev(i))) Then ref vsRev(i), map(LCase(vsRev(i)))
            End If
            
            'Modifier entfernen
            str = trim(rxModifyParamsRev.Replace(str, ""))
        Loop
        
        'umdrehen
        If i >= 0 Then
            ReDim vs(i): Dim j&: For j = i To 0 Step -1
                vs(j) = vsRev(i - j)
            Next j
        End If
        'Modifiers auslesen
        Static rxModifierRev As Object: cRxP rxModifierRev, "^([\w-_]+)([|$])(?!\\)", , True
        '0->modifier, 1->| oder $
        Do While rxModifierRev.test(str)
            Set parts = rxModifierRev.Execute(str)(0).subMatches
            Dim key$
            If parts(1) = "$" Then
                key = "print_r_format"
                vs = Array(StrReverse(parts(1)))
            Else
                key = LCase(StrReverse(parts(0)))
            End If
            If Not pModifiers.exists(key) Then pModifiers.add key, vs
            str = trim(rxModifierRev.Replace(str, ""))
        Loop
        extractModifiersRev = rxModifiersRev.Replace(extractModifiersRev, str)
    Loop
End Function

'|format:{format}
'|trim
'|rev
'|lower     |lcase
'|upper     |ucase
'|propert
'|strconv:{convType(Integer)}
'|tech
'|nz[:{default default:''}]
'|round[:{size default:0}]
'|sql       |code
'|reg_replace:{pattern}:{replace}       |rxr:{pattern}:{replace}
'|lpad:{len}[:{padString default ' '}]
'|rpad:{len}[:{padString default ' '}]
'/**
' * Führt die Modifier auf ein Wert aus
' * @param  Variant
' * @return Variant
' */
Private Function modify(ByVal iValue As Variant, Optional ByVal iKey As String) As Variant
On Error GoTo Err_Handler
    ref modify, iValue
    If pModifiers.count = 0 Then GoTo Exit_Handler    'Keine Modifier vorhanden
    Dim e$
    Dim keys: keys = pModifiers.keys
    Static rxSqlDelimiter As Object: If rxSqlDelimiter Is Nothing Then Set rxSqlDelimiter = cRx("/^(?:\[)?([^\]]+)(?:\])?$/")
    Dim i&: For i = pModifiers.count - 1 To 0 Step -1   'Die Modifiers sind in der verkehrten Reihenfolde im Dict
        pModifier = keys(i)
        
        Select Case LCase(pModifier)
            Case "item":
                Dim k: k = getModArg(0, , e, 0)
                Dim defaultK: defaultK = getModArg(1, , e, Null)
                Dim flagRunFirst: flagRunFirst = True
get_Item:
                If IsArray(iValue) Then
                    If LBound(iValue) <= k And k <= UBound(iValue) Then modify = iValue(k) Else: GoTo not_found
                ElseIf TypeName(iValue) = "Dictionary" Then
                    If IsNumeric(k) Then
                        Dim dictV: dictV = iValue.items
                        modify = dictV(CLng(k))
                    ElseIf iValue.exists(k) Then
                        modify = iValue(k)
                    Else
not_found:
                        If flagRunFirst And Not IsNull(defaultK) Then
                            flagRunFirst = False
                            k = defaultK
                            GoTo get_Item
                        Else
                            modify = Null
                            e = "item " & k & " not found in List " & iKey
                        End If
                    End If
                End If
'Extra für SQL-Excel-Tabelle: |tbl:<range>
            Case "tbl":                             modify = rxSqlDelimiter.Replace(modify, "[$1$" & getModArg(0, vbString, e, "") & "]")
                                                   'modify = "[" & modify & "$" & getModArg(0, vbString, e, "") & "]"
            Case "format":                          modify = format(modify, getModArg(0, vbString, e))
            Case "trim":                            modify = trim(modify)
            Case "rev":                             modify = StrReverse(NZ(modify))
            Case "lower", "lcase":                  modify = LCase(modify)
            Case "upper", "ucase":                  modify = UCase(modify)
            Case "proper":                          modify = StrConv(NZ(modify), vbProperCase)
            Case "strconv":                         modify = StrConv(NZ(modify), getModArg(0, vbLong, e))
            Case "tech", "techname":
                On Error Resume Next
                modify = Application.run("techName", NZ(modify))
                If Err.Number = 2517 Then modify = IIf(DEBUG_MODE, "{cast_techName ist nicht installiert}", modify)       'Funktion techName exisitert nicht
                Err.clear: On Error GoTo 0
            Case "nz":                              modify = NZ(modify, cVal(getModArg(0, , e, "")))
            Case "round":                           modify = round(CDbl(modify), getModArg(0, vbDouble, e, 0))
            Case "sql", "code":                     modify = toString(modify, True)
            Case "fld":
                Dim tbl$: tbl = getModArg(0, vbString, e, "")
                modify = IIf(tbl = "", "", rxSqlDelimiter.Replace(tbl, "[$1]")) & rxSqlDelimiter.Replace(modify, "[$1]")
            Case "regex_replace", "rxr":            modify = cRx(getModArg(0, vbString, e)).Replace(NZ(modify), getModArg(1, vbString, e))
#If sPrintF_exists Then
            Case "print_r_format":                  modify = sPrintF("%1$" & getModArg(0, vbString, e), NZ(modify))
#End If
            Case "lpad":
                Dim ln&, padString$: ln = getModArg(0, vbLong, e): padString = getModArg(1, vbString, e, " ")
                modify = Left(NZ(modify), ln)
                modify = modify & String(ln - Len(modify), padString)
            Case "rpad":
                ln = getModArg(0, vbLong, e): padString = getModArg(1, vbString, e, " ")
                modify = Right(NZ(modify), ln)
                modify = String(ln - Len(modify), padString) & modify
            'Nicht dokumentiert: Führt ein
            Case "cast":                            modify = eval(getModArg(0, vbString, e) & "('" & maskString(CStr(NZ(modify))) & "')")
            Case Else:
                On Error Resume Next
                'modify = Eval(pModifier & "('" & maskString(CStr(NZ(modify))) & "')")
                On Error GoTo Err_Handler
'            Case "run":
'                Dim vs(): vs = pModifiers(pModifier)
'                Dim cmd$: cmd = getModArg(UBound(vs), vbString, e)
'                Dim k&, args(): ReDim args(UBound(vs) - 1): For k = UBound(vs) - 1 To 0 Step -1: args(UBound(vs) - 1 - k) = IIf(vs(k) = "item", modify, vs(k)): Next
'                ref modify, callUdfByArray(cmd, args)
        End Select
    Next i
    
    
Exit_Handler:
    If e <> Empty Then Err.Raise vbObjectError, , e
    If IsObject(modify) Then Err.Raise 13
    Exit Function
Err_Handler:
    modify = "<Err: " & Err.Description & ">"
End Function

'/**
' * Liest ein Modifier-Arguemnt aus und überprüft es
' * @param  Long        Position in der arg-Liste (achtung, die ist verkehrt herum  |rpad:3:X -> {0:X, 1:3}
' * @param  vbVarType   Der Type, der zurückgegeben werden soll
' * @param  String      (out) Fehlermeldung
' * @param  Variant     Standardwert, falls der Wert nicht übergeben wurde
' * @return Varaint
' */
Private Function getModArg( _
    ByVal iArg&, _
    Optional ByVal iVarType As VbVarType = vbVariant, _
    Optional ByRef oError$, _
    Optional ByRef iDefault As Variant _
) As Variant
On Error GoTo Err_Handler

    Dim vs(): vs = pModifiers(pModifier)
    'If iArg > UBound(vs) Then Err.Raise 9
    Dim v: v = NZ(vs(iArg))
    Select Case iVarType
        Case vbString:  getModArg = CStr(v)
        Case vbDouble:  getModArg = CDbl(v)
        Case vbLong:    getModArg = CLng(v)
        Case Else:      getModArg = v
    End Select


Exit_Handler:
    Exit Function
Err_Handler:
    Dim txt$
    Select Case Err.Number
        Case 9:
            If Not IsMissing(iDefault) Then ref getModArg, iDefault: Exit Function
            'If Not IsNull(iDefault) Then getModArg = iDefault: Exit Function
            txt = "argument not exists"
        Case 13:    txt = "argument ''" & v & "'' type mismatch"      'Doppelte ' wegen dem Eval am Ende des parsens
        Case Else:  txt = Err.Description
    End Select
    oError = "[" & pModifier & "(" & iArg & ")] " & txt
    Err.Raise Err.Number
End Function

'/**
' * parst ein einzelner String aus #{parse mich}
' * @param  String
' * @return String
' */
Private Function parseJsfRev(ByVal iStringRev As String) As String
    Dim founds As Object
    Dim i As Long
On Error GoTo Err_Handler
    Dim formulaRev As String:     formulaRev = iStringRev
    
    ':, ! und ?innerhalb von '' maskieren
    Static rxStringsRev As Object:      cRxP rxStringsRev, "(['""])(.*?)\1(?!\\)", True     'Strings innerhalb von '' oder "" finden
    Static rxMaskSpecialRev As Object:  cRxP rxMaskSpecialRev, "([:\?\!](?!\\))", True      'Sonderzeichen finden :?!
    If rxStringsRev.test(formulaRev) Then
        Set founds = rxStringsRev.Execute(formulaRev)
        For i = founds.count - 1 To 0 Step -1
            Dim delim As String: delim = founds(i).subMatches(0)
            Dim strRev As String: strRev = founds(i).subMatches(1)
            If rxMaskSpecialRev.test(strRev) Then
                strRev = rxMaskSpecialRev.Replace(strRev, "$1\")
                formulaRev = substrReplace(formulaRev, strRev, founds(i).firstIndex + 1, founds(i).Length - 2)
            End If
        Next
    End If
    
    'Spezialfälle
    'iif in der Form: [?not] [when] ? [then] : [else]
    Static rxIfRev As Object: cRxP rxIfRev, "^\s*(?:([\s\S]*?)\s+:(?!\\))?\s+(?:([\s\S]+)\s*\?(?!\\))\s*([\s\S]*?)\s*((?:\ston)?)$", , True
    If rxIfRev.test(formulaRev) Then
        Dim m As Object: Set m = rxIfRev.Execute(formulaRev)(0)
        If Not m.subMatches(0) & m.subMatches(1) = "" Then
            Dim elseRev As String:  elseRev = IIf(m.subMatches(0) = "", "''", m.subMatches(0))
            Dim ifRev As String:    ifRev = IIf(m.subMatches(1) = "", "''", m.subMatches(1))
            formulaRev = rxIfRev.Replace(formulaRev, ")" & elseRev & " ," & ifRev & " ,$3 $4(fii")
        End If
    End If
    ' Gibt in $2 SPezialfälle zurück, die nicht innerhalb von '' oder "" liegen. Im moment: != und !
    Static rxNotLike As Object: formulaRev = cRxP(rxNotLike, "=!(?!\\)", True).Replace(formulaRev, " >< ")
    Static rxNot As Object:     formulaRev = cRxP(rxNot, "!(?!\\)", True).Replace(formulaRev, " ton ")
    
    ':, ! und ? demaskieren
    'Static rxDemaskSpecialRev As Object: formulaRev = cRxP(rxDemaskSpecialRev, "(['""#])(.*?)([:\?])\\(.*?\1)(?!\\)", True).Replace(formulaRev, "$1$2$3$4")
    Static rxDemaskSpecialRev As Object: formulaRev = cRxP(rxDemaskSpecialRev, "([:\?\!])\\(?!\\)", True).Replace(formulaRev, "$1")
    
    Dim formula As String: formula = parseFormula(formulaRev)
    
    'HTML-Zeichen umwandeln
    If flagRichText Then
        Static rxHtmlCharsRt As Object:  cRxP rxHtmlCharsRt, "&\w{3};"
        Do While rxHtmlCharsRt.test(formula)
            formula = rxHtmlCharsRt.Replace(formula, decodeHtmlChars(rxHtmlCharsRt.Execute(formula)(0)))
        Loop
    End If
    

    'Ausführen
    '#If ms_product = C_ACCESS Then
        'Static rxDate As Object: formula = cRxP(rxDate, "'(#[^#]+?#)'").replace(formula, "$1")
#If ms_product = C_ACCESS Then
        Dim value As Variant: value = (eval(formula))
#Else
        'Dim value As Variant: value = cVal(Replace(formula, "#", ""))
        Static rxEval As Object: If rxEval Is Nothing Then Set rxEval = cRx("/^('(?=['#]?)|#)([\s\S]*?)\1$/g")
        Dim value As Variant: value = rxEval.Replace(formula, "$2")
#End If
#If sPrintF_exists Then
        If pFormatPattern <> "" Then
            parseJsfRev = StrReverse(sPrintF("%1$" & pFormatPattern, value))
            Exit Function
        End If
#End If
        parseJsfRev = StrReverse(toString(value, False))

        
    '#Else
    '    parseJsfRev = StrReverse(toString(formula, False))
    '#End If
    
    Exit Function

Err_Handler:
    If DEBUG_MODE Then
        handleError Err, "parseJsfRev", iStringRev
    Else
        Select Case Err.Number
            Case 2482: parseJsfRev = StrReverse("${Missing: " & formula & "}")
            Case Else: parseJsfRev = StrReverse("${Error: #" & Err.Number & " " & Err.Description & ": " & formula & "}")
        End Select
    End If
    Exit Function
    Resume
End Function

'/**
' * Parst\t, \n  und \r
' * @param  String
' * @return String
' */
Private Sub parseFormatRev(ByRef ioTextRev As String)
    If Not flagParseFormat Then Exit Sub
    
    Static rxRev As Object: cRxP rxRev, "([tn])\\(?!\\)", , , True

    Do While rxRev.test(ioTextRev)
        Select Case LCase(rxRev.Execute(ioTextRev)(0).subMatches(0))
        'Tab
        Case "t":   ioTextRev = rxRev.Replace(ioTextRev, vbTab)    ' "chr(9)")
        'New Line/Line Feed
        Case "n":
            If flagRichText Then
                ioTextRev = rxRev.Replace(ioTextRev, ">vid<" & vbLf & vbCr & ">vid/<")
            Else
                ioTextRev = rxRev.Replace(ioTextRev, vbLf)     '"chr(10)")
            End If
        'Carriage Return
        'Case "r":                ioTextRev = rxRev.Replace(ioTextRev, "")     ' "chr(13)")
        End Select
    Loop
End Sub


'/**
' * Wandelt den Wert in einen String
' * @param  Variant
' * @param  Boolean     Flag ob es ein SQL-String sein soll, der auch mit eval() ausgewertet werden kann
' * @return String
' */
Private Function toString(ByVal iValue As Variant, Optional ByVal iReturnAsSql = False) As String
    If Not iReturnAsSql Then
        toString = CStr(NZ(iValue))
    ElseIf VarType(iValue) = vbString Then
        toString = "'" & iValue & "'"
    ElseIf IsNull(iValue) Then
        toString = "NULL"
    ElseIf IsDate(iValue) Then
        Dim frmt$: frmt = Switch(Int(iValue) = iValue, "\#MM\/DD\/YYYY\#", 1 > Abs(iValue), "\#HH:NN:SS\#", True, "\#MM\/DD\/YYYY HH:NN:SS\#")
        toString = format(CDate(iValue), frmt)
    ElseIf IsNumeric(iValue) Then
        toString = str(iValue)
    Else
        toString = "'" & iValue & "'"
    End If
End Function

'/**
' * Parst alle "Wörter"
' * @param  String
' * @return String
' */
Private Function parseFormula(ByVal iFormulaRev As String) As String
On Error GoTo Err_Handler

    'Modifier-Argumente: Seperator von ' oder " auf ~ wechseln
    Dim formulaRev As String: formulaRev = iFormulaRev
    Static rxModiferVars As Object: cRxP rxModiferVars, "([""'](?!\\))((?:(?!\1(?!\\)).)*)\1[:=](?!\\)"
    Do While rxModiferVars.test(formulaRev)
        Dim matchRev As Object: Set matchRev = rxModiferVars.Execute(formulaRev)(0)
        Dim itemRev As String: itemRev = matchRev.subMatches(1)
        itemRev = "~" & escapeRegExpPatternRev(itemRev) & "~:"
        formulaRev = substrReplace(formulaRev, itemRev, matchRev.firstIndex, matchRev.Length)
    Loop
    
    'Die einzelnen Elemente innerhalb  der #{} parsen
    '\u0030-\u007A\u00C0-\u00FF Alle Word-Zeichen und alle Spezialzeichen (Ä Ö etc.). https://www.torsten-horn.de/techdocs/ascii.htm
    Const C_ALL_P = "(?:[\u0030-\u007A\u00C0-\u00FF\-_~\\\:\|]|[\$\(\)](?=\\))+"
    Static rxPartsRev As Object: cRxP rxPartsRev, "((?:~[^~]+~:)?(?:(?:" & C_ALL_P & "\|)?([""'](?!\\))(?:(?!\2(?!\\)).)*?\2(?!\\)|(\S*\|)?\](?!\\)(\d)\[(?!\\)|" & C_ALL_P & "))", True
    '0->Hochkomma, 1->Wert, 2->Modifier bei Array , 3->Index bei Array [1]
    If rxPartsRev.test(formulaRev) Then
        Dim itemRevs As Object: Set itemRevs = rxPartsRev.Execute(formulaRev)
        Dim i As Long: For i = itemRevs.count - 1 To 0 Step -1
            itemRev = itemRevs(i).value
            Dim elemRef$: elemRef = IIf(itemRevs(i).subMatches(3) = "", itemRevs(i).value, itemRevs(i).subMatches(2) & itemRevs(i).subMatches(3))
            itemRev = parseElement(itemRevs(i).value, True, True)
            formulaRev = substrReplace(formulaRev, itemRev, itemRevs(i).firstIndex, itemRevs(i).Length)
        Next
    End If
    parseFormula = StrReverse(formulaRev)

Exit_Handler:
    Exit Function
Err_Handler:
    handleError Err, "parseFormula", iFormulaRev
    Resume Exit_Handler
    Resume
End Function

'/**
' * Parst ein Element. Entweder aus der Map oder den Wert selber
' * @param  String
' * @param  Boolean
' * @param  Boolean
' * @return String
' */
Private Function parseElement(ByVal iElementRev As String, Optional ByVal iReverse As Boolean = False, Optional ByVal iReturnAsSql = False) As String
On Error GoTo Err_Handler

    iElementRev = extractModifiersRev(iElementRev)
   
    Dim key As String: key = createKey(StrReverse(iElementRev))
    If map.exists(key) Then
        Dim value As Variant: ref value, map(key)
        value = maskString(value)
        value = modify(value, key)
        parseElement = toString(value, iReturnAsSql)
    ElseIf pModifiers.exists("nz") Then
        value = modify(Null, key)
        parseElement = toString(value, iReturnAsSql)
    Else
        parseElement = StrReverse(iElementRev)
        parseElement = modify(parseElement, key)
        parseElement = toString(parseElement)
    End If
    If iReverse Then parseElement = StrReverse(parseElement)
    Exit Function

Exit_Handler:
    Exit Function
Err_Handler:
    handleError Err, "Element", iElementRev, iReverse, iReturnAsSql
    Resume Exit_Handler
    Resume
End Function

Private Function maskString(ByVal iString)
    If VarType(iString) <> vbString Then maskString = iString: Exit Function
    maskString = Replace(iString, "'", "''")
    'Dim rx As Object
    'maskString = cRxP(rx, "(')", , True).replace(iString, "$1$1")
End Function

'/**
' * Zielen trimmen
' * @param  String      (in/out)
' */
Private Sub trimLines(ByRef ioText As String)
    If Not flagTrimLines Then Exit Sub

    Static rxRt As Object, rxRaw As Object

    If Not flagRichText Then    'Raw
        ioText = cRxP(rxRaw, "^[ \t]*(.*?)[ \t]*$", True, True).Replace(ioText, "$1")
    Else                        'RichText
        ioText = cRxP(rxRt, "<div>\s*(.*?)\s*<\/div>", True, , True).Replace(ioText, "<div>$1</div>")
    End If
End Sub

'/**
' * Leere Tags entfernen (ausser <div></div>)
' * @param  String      (in/out)
' */
Private Sub removeEmptyTags(ByRef ioText As String)
    If Not flagRichText Then Exit Sub
    Static rxRt As Object: ioText = cRxP(rxRt, "<(?!div)(\w+)(\s[^>]*)?><\/\1>", True).Replace(ioText, "")
End Sub

'/**
' * Leere Zeilen entfernen
' * @param  String      (in/out)
' */
Private Sub removeEmptyLine(ByRef ioText As String)
    If Not flagRemoveEmptyLine Then Exit Sub
    Static rxRaw As Object, rxRt As Object
    If Not flagRichText Then    'Raw
        ioText = cRxP(rxRaw, "(?:^\s*\n|(\n)\s*\n|\n\s*$)", True).Replace(ioText, "$1")
    Else                        'RichText
        ioText = cRxP(rxRt, "<div>\s*<\/div>[\r\n]*", True, , True).Replace(ioText, "")
    End If
End Sub

'/**
' * Mehrfach Leerzeichen reduzieren
' * @param  String      (in/out)
' */
Private Sub trimMultiSpaces(ByRef ioText As String)
    If Not flagTrimMultiSpaces Then Exit Sub

    Static rx As Object: ioText = cRxP(rx, "[ \t]{2,}", True).Replace(ioText, " ")
End Sub

'/**
' * Entfernt Zeilenumbrüche
' * @param  String      (in/out)
' */
Private Sub removeNewLineRev(ByRef ioTextRev As String)
    If Not flagRemoveNewLine Then Exit Sub
    If Not flagRichText Then
        Static rxRawRev As Object: ioTextRev = cRxP(rxRawRev, "[\n\r]+", True).Replace(ioTextRev, "")
    Else
    
    End If
End Sub

'/**
' * Entfernt CarriageReturn. \r
' * @param  String      (in/out)
' */
Private Sub removeCarriageReturn(ByRef ioText As String)
    Static rx As Object:
    ioText = cRxP(rx, "\r", True).Replace(ioText, "")
End Sub

'/**
' * Erstellt aus einem Unix-NewLine ein Windows NewLine:    \n -> \r\n
' * @param  String      (in/out)
' */
Private Sub winNewLine(ByRef ioText As String)
    If flagUnixNewLine Then Exit Sub
    Static rx As Object: ioText = StrReverse(cRxP(rx, "\n(?!\r)", True).Replace(StrReverse(ioText), vbLf & vbCr))
End Sub

'/**
' * Erstellt Keys: Einmal mit _ anstelle von Leerzeichen und einmal ohne diese
' * Extrahiert auch den Key aus []
' * @param  String
' * @param  String  (out) Key ohne _, -, Tabulator und Leerzeichen
' * @return String  Key ohne Tabulator und Leerzeichen
' */
Private Function createKey(ByVal iKey As String, Optional ByRef oKey As String) As String
    Static rx1 As Object, rx2 As Object, rx3 As Object
    Dim key As String: key = LCase(cRxP(rx1, "^(?:\[([\s\S]+?)\]|([\s\S]+))$", True).Replace(iKey, "$1$2"))
    createKey = cRxP(rx2, "[ \t]+", True).Replace(key, "_")
    oKey = cRxP(rx3, "[ \t_-]+", True).Replace(key, "")
End Function

Private Function decodeHtmlChars(ByVal iHtml As String) As String
    Static xDoc As Object: If xDoc Is Nothing Then Set xDoc = CreateObject("Msxml2.DOMDocument.6.0")
    xDoc.LoadXML ("<root>") & iHtml & "</root>"
    decodeHtmlChars = xDoc.SelectSingleNode("root").nodeTypedValue
End Function

'/**
' * erstellt eine RegExp und gibt ihn zurück, falls er nicht schon initialisiert ist. Eigent sich gut mit Static
' * @example    Static rx: cRxP(rx, "'(\w+)', True).replace("'ABC'", "$1")
' * @param  RegExp      (in/out) RegExp Objekt
' * @param  String      Pattern
' * @param  Boolean     Flag Global
' * @param  Boolean     Flag MultiLine
' * @param  Boolean     Flag IgnoreCase
' * @retrun RegExp
' */
Private Function cRxP( _
        ByRef ioRx As Object, _
        ByVal iPattern As String, _
        Optional ByVal iGlobal As Boolean = False, _
        Optional ByVal iMultiline As Boolean = False, _
        Optional ByVal iIgnoreCase As Boolean = False _
) As Object
    If ioRx Is Nothing Then
        Set ioRx = CreateObject("VBScript.RegExp")
        ioRx.pattern = iPattern:        ioRx.IgnoreCase = iIgnoreCase:       ioRx.Global = iGlobal:     ioRx.Multiline = iMultiline
    End If
    Set cRxP = ioRx
End Function


'-------------------------------------------------------------------------------
' -- Private Properties
'-------------------------------------------------------------------------------

'/**
' * Setzt einen spezifischen Paramter
' * @param  jsfParams
' * @param  Boolean
' */
Private Property Let param(ByVal iParam As jsfParams, ByVal iFlag As Boolean)
    If andB(pParams, iParam) = iFlag Then Exit Property 'Flag ist bereits richtig
    If andB(pParams, iParam) Then pParams = pParams - iParam: Exit Property
    If iFlag Then pParams = pParams + iParam: Exit Property
End Property
Private Property Get param(ByVal iParam As jsfParams) As Boolean
    param = andB(pParams, iParam)
End Property

'-------------------------------------------------------------------------------
' -- Private Events
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
    pParams = jsfParams.[_Default]
#If Log4vba Then
    Set pLogger = Log4vba(DEBUG_MODE)
    pLogger.setTypeSettings ltError, C_ERROR_LOG_SETTINGS
#End If
End Sub


'-------------------------------------------------------------------------------
' -- Libraries
'-------------------------------------------------------------------------------


'/**
' * Bei einer Variablenübergabe muss immer unterscheiden werden, ob es ein Objekt ist oder nicht.
' * Diese Sub nimmt einem die Arbeit ab
' * ref(oNode, iNode)
' * @param  Variant     Variable, die den Wert bekommen soll
' * @param  Variant     Ret Wert selber
' */
Private Sub ref(ByRef oNode As Variant, ByRef iNode As Variant)
    If IsObject(iNode) Then Set oNode = iNode: Exit Sub
    oNode = iNode
End Sub

'/**
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/andb
' * Macht einen Bit-Vergleich
' * @param  Long
' * @param  Long
' * @return Boolean
' */
Private Function andB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Boolean
    andB = ((iHaystack And iNeedle) = iNeedle)
End Function

'Analog zu substr_replace aus PHP
'iString
'Die Eingabezeichenkette.
'
'iReplacement
'Die Ersetzungszeichenkette
'
'iStart
'Ist start positiv, beginnt die Ersetzung ab der im Offset-Parameter start definierten Stelle innerhalb von string .
'Ist start negativ, wird vom Ende der Zeichenkette string bis zum Wert von start rückwärts gezählt und dort mit dem Austausch begonnen.
'
'iLength
'Ist der Parameter angegeben und positiv, stellt dieser Parameter die Länge des auszuwechselnden Teils von string dar. Ist der Wert negativ, gibt er die Zeichenzahl an, um die ab Ende von
'string rückwärts gezählt wird. Bis zu dieser Stelle erfolgt dann der Austausch. Ist der Parameter nicht angegeben, wird standardmäßig eine Ersetzung bis zum Ende des Strings (strlen(string ))
'durchgeführt, das heißt, die Ersetzung endet mit dem Ende von string . Sollte length den Wert null haben, wird die Funktion die Zeichenkette replacement in string an der durch start
'bezeichneten Stelle einfügen.

'/**
' * Ersetzt Text innerhalb einer Zeichenkette
' * @param  String      Die Eingabezeichenkette
' * @param  String      Die Ersetzungszeichenkette
' * @param  Integer     Start
' * @param  Integer     Länge
' * @return String
' */
Private Function substrReplace(ByVal iString As String, ByVal iReplacement As String, ByVal iStart As Integer, Optional ByVal iLength As Variant = Null) As String
    Dim startP As Integer:  startP = IIf(Sgn(iStart) >= 0, iStart, greatest(Len(iString) + iStart, 1))
    Dim Length As Integer:  Length = NZ(iLength, Len(iString) - iStart)
    Dim endP   As Integer
    
    Select Case Sgn(Length)
        Case 1:     endP = least(startP + Length, Len(iString))
        Case 0:     endP = startP
        Case -1:    endP = greatest(Len(iString) + Length, startP)
    End Select
    
    substrReplace = Left(iString, startP) & iReplacement & Mid(iString, endP + 1)
    
End Function

' * Gibt den Grössten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example greatest("Hallo Welt", 42, "Mister-X") -> Mister-X
'*/
Private Function greatest(ParamArray iItems() As Variant) As Variant
    greatest = iItems(UBound(iItems))
    Dim item As Variant: For Each item In iItems
        If NZ(item) > NZ(greatest) Then greatest = item
    Next item
End Function

'/**
' * Gibt den Kleinsten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example least("Hallo Welt", 42, "Mister-X") -> 42
'*/
Private Function least(ParamArray iItems() As Variant) As Variant
    least = iItems(LBound(iItems))
    Dim item As Variant: For Each item In iItems
        If NZ(item) < NZ(least) Then least = item
    Next item
End Function

'/**
' * 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

'/**
' * Escapte alle Sonderzeichen um eine rx-Pattern zu erstellen
' *
' *     string = escapeRegExpPattern(string)
' *
' * @example    escapeRegExpPattern("Hallo Welt. Geht es dir (noch) gut?")
' *             Hallo Welt\. Geht es dir \(noch\) gut\?
' * @param  String
' * @return String
' */
Private Function escapeRegExpPatternRev(ByVal iPattern As String) As String
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/([\\\*\+\?\|\{\[\](\)\^\$\.\#])/g")
    escapeRegExpPatternRev = rx.Replace(iPattern, "$1\")
End Function

'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern$) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.Execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function

'/**
' * Version 1.3.0
' * Es wird versucht, den Paramter in seine eigentlichen Typ zu wandeln. Gar mit Textausgaben oder parsen von SQL interessant
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cval
' * @example    cVal("Null") -> Null, cVal("True") -> -1, cVal("time") -> 15:08:37
' * @param  Variant
' * @return Variant
' */
Private Function cVal(ByVal iValue As Variant) As Variant
On Error Resume Next
#If ms_product = C_ACCESS Then
    Set cVal = iValue: cVal = iValue:  cVal = eval(iValue)
#Else
    Set cVal = iValue: cVal = iValue: cVal = CDbl(iValue): cVal = CLng(iValue): cVal = CInt(iValue):  cVal = eval(iValue)
    cVal = IIf(UCase(iValue) = "NULL", Null, cVal)
#End If
    If IsDate(iValue) Then cVal = CDate(iValue)
    Select Case UCase(iValue)
        Case "EMPTY":       cVal = Empty
        Case "NOTHING":     Set cVal = Nothing
        Case "FALSE":       cVal = False
        Case "TRUE":        cVal = True
    End Select
    'Falls der TExt einem reservierten Wort entspricht, fällt eval auf den Kopf. Darum direkt mappen
    If reservedWords.exists(UCase(iValue)) Then ref cVal, iValue
End Function
'Für cVal angepasste Version, Folgende Items entfernt: False, True, Null, Nothing, Empty
Private Property Get reservedWords() As Object
    'https://bettersolutions.com/vba/syntax/keywords.htm um 'name' ergänzt
    Const C_RWORDS$ = "#If,#Else,#Else If,#End If,#Const,Alias,And,As,Base,Boolean,Byte,ByRef,ByVal," & _
        "Call,Case,CBool,CByte,CCur,CDate,CDbl,CInt,CLng,CLngLng,CLngPtr,Compare,Const,CSng,CStr,Currency,Var," & _
        "Database,Date,Declare,DefBool,DefByte,DefDate,DefDec,DefDouble,DefInt,DefLng,DefLngLng,DefLngPtr,DefObj,DefSng,DefStr,Dim,Do,Double," & _
        "Each,Else,ElseIf,End,Enum,Erse,Error,Event,Exit,Explicit,For,Friend,Function,Get,Global,GoTo,If,IIf,Implements,Integer,Is," & _
        "Let,LBound,Lib,Like,Long,LongLong,Loop,LSet,Me,Mod,Name,New,Next,Not,Object,On,Option,Optional,Or," & _
        "ParamArray,Preserve,Private,Property,Public,RaiseEvent,ReDim,Resume,Return,RSet,Select,Set,Single,Static,Step,Stop,String,Sub," & _
        "Text,ThenTo,Type,TypeOf,UBound,Until,Variant,Wend,While,With,WithEvents"
    Static dict As Object
    If dict Is Nothing Then
        Set dict = CreateObject("scripting.Dictionary")
        Dim rWordsArr$(): rWordsArr = Split(UCase(C_RWORDS), ",")
        Dim i&: For i = 0 To UBound(rWordsArr)
            dict.add trim(rWordsArr(i)), True
        Next i
    End If
    Set reservedWords = dict
End Property

'/**
' * Führt eine UserDefinedFunction aus. Im Gegensatz zu Application.run werden die Parameter in einem Array übergeben
' * @param  String      Name der UserDefinedFunction
' * @param  Array       Die Argumente zur Funktion
' * @return Variant     Rückgabewert der Funktion
' */
Private Function callUdfByArray(ByVal iMethodName As String, ByRef iArgs As Variant) As Variant
    Dim diff As Integer: diff = LBound(iArgs)
    Select Case UBound(iArgs) - diff
        Case -1:    ref callUdfByArray, Application.run(iMethodName)
        Case 0:     ref callUdfByArray, Application.run(iMethodName, iArgs(diff))
        Case 1:     ref callUdfByArray, Application.run(iMethodName, iArgs(diff), iArgs(1 + diff))
        Case 2:     ref callUdfByArray, Application.run(iMethodName, iArgs(diff), iArgs(1 + diff), iArgs(2 + diff))
        Case 3:     ref callUdfByArray, Application.run(iMethodName, iArgs(diff), iArgs(1 + diff), iArgs(2 + diff), iArgs(3 + diff))
        Case 4:     ref callUdfByArray, Application.run(iMethodName, iArgs(diff), iArgs(1 + diff), iArgs(2 + diff), iArgs(3 + diff), iArgs(4 + diff))
        Case 5:     ref callUdfByArray, Application.run(iMethodName, iArgs(diff), iArgs(1 + diff), iArgs(2 + diff), iArgs(3 + diff), iArgs(4 + diff), iArgs(5 + diff))
        Case 6:     ref callUdfByArray, Application.run(iMethodName, iArgs(diff), iArgs(1 + diff), iArgs(2 + diff), iArgs(3 + diff), iArgs(4 + diff), iArgs(5 + diff), iArgs(6 + diff))
        'TODO: Aufruf mit weiteren Parametern ermöglichen
        Case Else:  Err.Raise 450     'Wrong number of arguments or invalid property assignment
    End Select

End Function


#If ms_product = C_EXCEL Then
    '/**
    ' * Wandelt NULL in EMpty oder einen Defaultwert
    ' * @param  Variant
    ' * @param  Variant
    ' * @return Variant
    ' */
    Private Function NZ(ByRef iValue As Variant, Optional ByRef iDefault As Variant = Empty) As Variant
        If IsNull(iValue) Then
            NZ = iDefault
        Else
            NZ = iValue
        End If
    End Function
#End If