VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Log4vba"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : Log4vba.cls
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/classes/log4vba
'Environment  : VBA 2016+
'Version      : 1.5.6
'Name         : Log4vba
'Author       : Stefan Erb (ERS)
'History      : 23.11.2016 - ERS - Creation
'               ...
'               02.05.2017 - ERS - Singelton entfernt. Braucht es nicht, da mit Log4Vba dierekt auf den VBA-Singelton der Klasse zugeriffen werden kann
'               28.06.2017 - ERS - NZ() für Excel hinzugefügt
'               16.07.2018 - ERS - isEmptyArray neu mit isMissing gelöst
'               21.08.2019 - ERS - Fehler in varArray2String() behoben.
'               04.09.2019 - ERS - Array() durch emptyArrayVariant() ersetzt
'               16.09.2019 - ERS - UserDefined LogType gefixt
'               21.10.2019 - ERS - debug.assert nach MsgBox nur noch bei Yes
'-------------------------------------------------------------------------------
Option Explicit

'Ein Logger für VBA
'Anleitung und Tipps unter http://wiki.yaslaw.info/dokuwiki/doku.php/vba/classes/log4vba

'-------------------------------------------------------------------------------
' -- ! 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_ACCESS

'Die folgenden 2 Module werden NICHT benötigt. Wenn sie aber eingebunden sind,
'dann können die Debug-Strings oder die Source-String detailierter ausgegeben werden.

'Angabe, ob das Modul lib_json in diesem Projekt vorhanden ist oder nicht
'http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/json
'Ab lib_json Version 2.1.0
#Const lib_json_exists = False

'Angabe, ob das Modul lib_printR in diesem Projekt vorhanden ist oder nicht
'wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/print_r
#Const lib_printr_exists = False


'Den Standard Debug Mode
Private Const C_DEBUG_MODE_DEFAULT = False
'Standard Logtabellenname
Private Const C_LOG_TABLE_DEFAULT = "T_LOG"
'Standard Anzahl Logeinträge die behalten werden
Private Const C_LOG_BUFFER_DEFAULT = 2000

'Durch was ' im SQL ersetzt werden muss
Private Const C_SQL_QUOTA_REPLACE = "''"


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

'/**
' * Log-Eiträge als Event ausgeben
' * @param  eLogType
' * @param  String
' */
Public Event log(logType As eLogType, text As String)

'/**
' * Typ zum Loggen
' */
Public Enum eLogType
    [_NA] = -1           'LogType ist bei der übergabe nicht definiert. Je nach Methode nimmt er nachher den Standard-LogType oder alle
    [_FIRST_TYPE] = -1
    ltDebug = 1         'Debug      Wird nur bei debugMode True ist geloggt
    ltInfo = 2          'Info
    ltWarning = 3       'Warning
    ltError = 4         'Error
    [_DEBUG] = 5        'Neben dem normalen debug, ein spezieller interner Type
    [_LAST_TYPE] = 5
    [_Default] = ltInfo
End Enum

'/**
' * Die Auswahl an Möglichkeiten zur Ausgabe
' */
Public Enum eTypeSetting
    [_NA] = -1
    eprNothing = 0                  'Keine Rück-/Ausgabe
    
    'Angaben über den Return_Wert. Sind nicht kombinierbar. Bei mehrfachwahl ist wird der Erste verwendet
    eprReturnAssert = 2 ^ 0         'Rückgabewert für debug.assert
    eprReturnMsg = 2 ^ 1            'Rückgabewert ist die Fehlermeldung
    
    'Angaben, was mit der Meldung gemacht werden soll. Sie können kombiniert werden
    eprOutConsole = 2 ^ 2           'Ausgabe ins Direktfenster
    eprOutMsgBox = 2 ^ 3            'Als MassegeBox ausgeben
    eprOutLogFile = 2 ^ 4           'In ein LogFile schreiben  (DB-Pfad\DB-Name.log)
#If ms_product = C_ACCESS Then
    eprOutFunction = 2 ^ 9          'eine Funktion, welche mittels eval ausgeführt wird
#End If
#If ms_product = C_ACCESS Or ms_product = C_EXCEL Then
    eprOutTable = 2 ^ 10            'In eine Tabelle. Geht nur bei Access oder Excel
#End If
    
    'Angaben zur Formatierung. Sie können kombiniert werden
    eprFrmtSourceExtend = 2 ^ 5     'Beim zusammensetzen der Source die Originalsource nicht ersetzen sondern erweitern
    eprFrmtNoSource = 2 ^ 8         'Die Source nicht anzeigen
    eprFrmtJson = 2 ^ 6             'Json wird höher gewertet als printR
    eprFrmtPrintR = 2 ^ 7           'PrintR wird höher gewertet als json
    eprFrmtNoFormat = 2 ^ 11        'Weder json noch print_r unterstützen, auch wenn die Constante dies zulassen würde
    
    'Standards pro logType
    [_DEBUG_DEFAULT] = eprOutConsole + eprFrmtPrintR + eprFrmtJson
    [_INFO_DEFAULT] = eprOutConsole
    [_WARNING_DEFAULT] = eprOutConsole + eprOutMsgBox
    [_ERROR_DEFAULT] = eprOutConsole + eprOutMsgBox + eprReturnAssert
    [_USER_TYPE_DEFAULT] = eprOutConsole + eprOutMsgBox
End Enum

'/**
' * Angabe, um was für ein Logger es sich handelt
' * Man muss sich im Normalfall nicht darum kümmern
' */
Public Enum eLoggerType
    eltUnbound  'Ein unabhängiger Logger
    eltMethode  'Ein Methoedenlogger
    eltClass    'EinKlassenlogger
End Enum

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

'/**
' * Alle Information zu einem Logeintrag
' */
Private Type tItem
    Description     As Variant      'String oder Array<String>
    Source          As String
    path()          As String
    variablen       As String
    Number          As Long
    debugText       As Variant
    timeStamp       As Date
    logMsg          As String
    logType         As eLogType
    setting         As eTypeSetting
    loggerType      As eLoggerType
End Type

Private Declare Function emptyArrayVariant Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbVariant, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Variant()

Private pTypeSettings()     As eTypeSetting  'Settings pro Typ
Private pTypeNames()        As String
Private pDebugMode          As Boolean
Private pLastAssert         As tItem
Private pActualMethode      As String
Private pFunctionName       As String
Private pLogTable           As String
Private pPath()             As String
Private pLoggerType         As eLoggerType
Private pSessionId          As Long
Private pParent             As Log4vba

'-------------------------------------------------------------------------------
' -- Public Constructors
'-------------------------------------------------------------------------------

'/**
' * Erstellt eine neue Instanz von Log4vba
' * @param  Boolean Debug-mode
' * @return Log4vba
' */
Public Function instance(Optional ByVal iDebugMode As Boolean = C_DEBUG_MODE_DEFAULT) As Log4vba
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    Set instance = New Log4vba:     instance.construct iDebugMode
End Function

'/**
' * Startet eine Logging für eine Methode
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @return Log4vba         Ein Clone des Objektes
' */
Public Function startMethode(ByVal iSource As String, ParamArray iValueArray() As Variant) As Log4vba
    Set startMethode = Me.clone
    startMethode.init pPath, iSource, eltMethode
    Set startMethode.parent = Me
    If debugmode Then startMethode.debugMsg "started", iSource, CVar(iValueArray)
End Function

'/**
' * Startet eine Logging für eine Methode
' * @param  Variant         Name der Klasse oder die Instanz
' * @return Log4vba         Ein Clone des Objektes
' */
Public Function startClass(ByRef iClass As Variant) As Log4vba
    Set startClass = Me.clone
    Dim cn As String
    If IsObject(iClass) Then
        cn = TypeName(iClass)
    Else
        cn = iClass
    End If
    startClass.init pPath, cn, eltClass
    Set startClass.parent = Me
    If debugmode Then startClass.debugMsg "created"
End Function

'/**
' * Setzt Standardwerte für eine bestehende Instanz
' * @param  Boolean Debug-mode
' * @return Log4vba
' */
Public Function construct(Optional ByVal iDebugMode As Boolean = C_DEBUG_MODE_DEFAULT) As Log4vba
    resetSettings
    debugmode = iDebugMode
    Set construct = Me
End Function

'-------------------------------------------------------------------------------
' -- Private Constructors
'-------------------------------------------------------------------------------

'/**
' * Standardwerte setzen
' */
Private Sub Class_Initialize()
    resetSettings
End Sub
'/**
' * Steam schliessen
' */
Private Sub Class_Terminate()
    logFileStream.Close
    If pLoggerType = eltMethode Then endMethode
    If pLoggerType = eltClass Then endClass
End Sub

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

'/**
' * Ordnet diverse Werte auf einmal dem Objekt zu
' * Wird für die eigene Vererbung verwendet
' * @param  String  Klassenpfad
' * @param  String  Source
' * @param  eLoggerType
' */
Public Sub init(ByRef iClassPath() As String, Optional ByVal iSource As String = Empty, Optional ByVal iLoggerType As eLoggerType = eltUnbound)
    pPath = iClassPath
    className = iSource
    loggerType = iLoggerType
End Sub

'/**
' * Einen Benutzerspezifischen Type hinzufügen
' * @param  Integer
' * @param  String
' * @param  eTypeSetting
' */
Public Function addUserType(ByVal iLevel As Integer, ByVal iName As String, Optional ByVal iSettings As eTypeSetting = eTypeSetting.[_USER_TYPE_DEFAULT]) As Log4vba
    If iLevel >= LBound(pTypeNames) And iLevel <= UBound(pTypeNames) Then
        If Not pTypeSettings(iLevel) = 0 Then
            Err.Raise vbObjectError, "Log4vba.addLevel()", "Value is not free"
            Exit Function
        End If
    End If
    ReDim Preserve pTypeSettings(least(iLevel, LBound(pTypeSettings)) To greatest(iLevel, UBound(pTypeSettings)))
    ReDim Preserve pTypeNames(LBound(pTypeSettings) To UBound(pTypeSettings))
    pTypeSettings(iLevel) = iSettings
    pTypeNames(iLevel) = iName
    Set addUserType = Me
End Function

'/**
' * Beendet einen methodengebundenen Logger
' */
Public Sub endMethode()
    If pLoggerType = eltMethode And debugmode Then assert "ended", ltDebug, pActualMethode
    pActualMethode = Empty
End Sub

'/**
' * Beendet einen mklassengebundenen Logger
' */
Public Sub endClass()
    If pLoggerType = eltClass And debugmode Then assert "terminated", ltDebug
End Sub


'/**
' * Setzt alle settings auf den Standard zurück
' * @param  LogType     Falls gesetzt, wird nur der eine Logtype zurückgesetzt
' */
Public Sub resetSettings(Optional ByVal iLogType As eLogType = eLogType.[_NA])
    If iLogType = eLogType.[_NA] Then
    ReDim pTypeNames(eLogType.[_FIRST_TYPE] To eLogType.[_LAST_TYPE])
    pTypeNames(ltDebug) = "DEBUG"
    pTypeNames(ltInfo) = "INFO"
    pTypeNames(ltWarning) = "WARNING"
    pTypeNames(ltError) = "ERROR"
    pTypeNames(eLogType.[_DEBUG]) = "DEBUG"
    pTypeNames(eLogType.[_NA]) = "N/A"
     
    ReDim pTypeSettings(eLogType.[_FIRST_TYPE] To eLogType.[_LAST_TYPE])
    End If
    If Not iLogType = eLogType.[_NA] Then debugmode = C_DEBUG_MODE_DEFAULT
#If ms_product = C_ACCESS Then
    If iLogType = eLogType.[_NA] Then functionName = Empty
#End If
#If ms_product = C_ACCESS Or ms_product = C_EXCEL Then
    If iLogType = eLogType.[_NA] Then logTable = C_LOG_TABLE_DEFAULT
#End If
    If iLogType = eLogType.[_NA] Or iLogType = ltInfo Then typeSettings(ltInfo) = eTypeSetting.[_INFO_DEFAULT]
    If iLogType = eLogType.[_NA] Or iLogType = ltWarning Then typeSettings(ltWarning) = eTypeSetting.[_WARNING_DEFAULT]
    If iLogType = eLogType.[_NA] Or iLogType = ltError Then typeSettings(ltError) = eTypeSetting.[_ERROR_DEFAULT]
    If iLogType = eLogType.[_NA] Or iLogType = ltDebug Then typeSettings(ltDebug) = eTypeSetting.[_DEBUG_DEFAULT]
End Sub

'/**
' * Nur eine Message im Debugmodus ausgeben
' * @param  String          Freier Text der im Log erscheint
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @param  eTypeSetting    Die Setings für diesen Type einmalig übersteuern
' * @return Boolen/String   Rückgabewert für debug.assert oder LogMessage
' */
Public Function debugMsg( _
        ByVal iComment As String, _
        Optional ByVal iSource As String, _
        Optional ByRef iValueArray As Variant, _
        Optional ByVal iOverwriteSetting As eTypeSetting = eTypeSetting.[_NA] _
) As Variant
    If Not debugmode Then Exit Function
    debugMsg = assert(iComment, ltDebug, iSource, iValueArray, , iOverwriteSetting)
End Function

'/**
' * Debug für eine Variable
' * @param  String          Freier Text der im Log erscheint
' * @param  Variant         Variable, die ausgewertet werden soll
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @param  eTypeSetting    Die Setings für diesen Type einmalig übersteuern
' * @return Boolen/String   Rückgabewert für debug.assert oder LogMessage
' */
Public Function debugValue( _
        Optional ByVal iComment As Variant, _
        Optional ByVal iValue As Variant, _
        Optional ByVal iSource As String, _
        Optional ByRef iValueArray As Variant, _
        Optional ByVal iOverwriteSetting As eTypeSetting = eTypeSetting.[_NA] _
) As Variant
    If Not debugmode Then Exit Function
    'Kein Value übergeben -> debugMsg
    If IsMissing(iValue) And Not IsArray(iValue) Then
        debugValue = debugMsg(iComment, iSource, iValueArray, iOverwriteSetting)
        Exit Function
    End If
    debugValue = assert(iComment, ltDebug, iSource, iValueArray, , iOverwriteSetting, iValue)
End Function

'/**
' * @param  ErrObject/String
' * @param  Long            Error-Nummer
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @param  eTypeSetting    Die Setings für diesen Type einmalig übersteuern
' * @return Boolen/String   Rückgabewert für debug.assert oder LogMessage
' */
Public Function info( _
        ByRef iError As Variant, _
        Optional ByVal iSource As String, _
        Optional ByRef iValueArray As Variant, _
        Optional ByVal iNumber As Long, _
        Optional ByVal iOverwriteSetting As eTypeSetting = eTypeSetting.[_NA] _
) As Variant
    info = assert(iError, ltInfo, iSource, iValueArray, iNumber, iOverwriteSetting)
End Function

'/**
' * @param  ErrObject/String
' * @param  Long            Error-Nummer
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @param  eTypeSetting    Die Setings für diesen Type einmalig übersteuern
' * @return Boolen/String   Rückgabewert für debug.assert oder LogMessage
' */
Public Function warning( _
        ByRef iError As Variant, _
        Optional ByVal iSource As String, _
        Optional ByRef iValueArray As Variant, _
        Optional ByVal iNumber As Long, _
        Optional ByVal iOverwriteSetting As eTypeSetting = eTypeSetting.[_NA] _
) As Variant
    warning = assert(iError, ltWarning, iSource, iValueArray, iNumber, iOverwriteSetting)
End Function

'/**
' * @param  ErrObject/String
' * @param  Long            Error-Nummer
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @param  eTypeSetting    Die Setings für diesen Type einmalig übersteuern
' * @return Boolen/String   Rückgabewert für debug.assert oder LogMessage
' */
Public Function error( _
        ByRef iError As Variant, _
        Optional ByVal iSource As String, _
        Optional ByRef iValueArray As Variant, _
        Optional ByVal iNumber As Long, _
        Optional ByVal iOverwriteSetting As eTypeSetting = eTypeSetting.[_NA] _
) As Variant
    error = assert(iError, ltError, iSource, iValueArray, iNumber, iOverwriteSetting)
End Function

'/**
' * Analog zuinfo() error() etc. für die User-Typen
' * @param  eLogType    Typ der gelogt werden doll
' * @param  ErrObject/String
' * @param  Long            Error-Nummer
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @param  eTypeSetting    Die Setings für diesen Type einmalig übersteuern
' * @return Boolen/String   Rückgabewert für debug.assert oder LogMessage
' */
Public Function logUserType( _
        ByVal iLogType As eLogType, _
        ByRef iError As Variant, _
        Optional ByVal iSource As String, _
        Optional ByRef iValueArray As Variant, _
        Optional ByVal iNumber As Long, _
        Optional ByVal iOverwriteSetting As eTypeSetting = eTypeSetting.[_NA] _
) As Variant
    logUserType = assert(iError, iLogType, iSource, iValueArray, iNumber, iOverwriteSetting)
End Function

Public Function setTypeSettings(ByVal iLogType As eLogType, ByVal iSetting As eTypeSetting) As Log4vba
    typeSettings(iLogType) = iSetting
    Set setTypeSettings = Me
End Function

#If ms_product = C_ACCESS Then
    '/**
    ' * löscht alte Logeinträge
    ' * @param  Long
    ' * @return Anzahl gelöschter Einträge
    ' */
    Public Function deleteOldLogEntriesFromTable(Optional ByVal iDaysBack As Long = C_LOG_BUFFER_DEFAULT) As Long
    On Error GoTo Err_Handler
        If Not logTableExists Then Exit Function
        Dim sql As String:  sql = "datediff('d', [LOG_TIMESTAMP], NOW()) > " & iDaysBack
        deleteOldLogEntriesFromTable = DCount("*", pLogTable, sql)
        sql = "delete * from [" & pLogTable & "] where " & sql
        CurrentDb.execute sql
Exit_Handler:
        debugMsg "delete old logentries", "Log4vba.deleteOldLogEntriesFromTable", Array(deleteOldLogEntriesFromTable)
        Exit Function
Err_Handler:
        deleteOldLogEntriesFromTable = 0
        GoTo Exit_Handler
    End Function
#End If

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

'/**
' * Parent Logger
' * @return log4vba
' */
Public Property Get parent() As Log4vba:                            Set parent = pParent:           End Property
Public Property Set parent(ByRef IParent As Log4vba):               Set pParent = IParent:          End Property

'/**
' * Session ID
' * @return Long
' */
Public Property Get sessionId() As Long:                            sessionId = pSessionId:         End Property
Public Property Let sessionId(ByVal iId As Long)
    pSessionId = iId
    'SessionID nach oben vererben
    If Not parent Is Nothing Then parent.sessionId = iId
End Property
'/**
' * Typ des Loggers
' * @return eLoggerType
' */
Public Property Get loggerType() As eLoggerType:                   loggerType = pLoggerType:        End Property
Public Property Let loggerType(ByVal iLoggerType As eLoggerType):  pLoggerType = iLoggerType:       End Property


''/**
'' * Information, ob der Logger einer Klasse angehört
'' * @return Boolean
'' */
Public Property Get isClassLogger() As Boolean:
On Error Resume Next
    isClassLogger = LBound(pPath) = 0
End Property

'/**
' * setzt oder gibt den aktuellen Klassennamen
' * @return String
' */
Public Property Get className() As String
On Error Resume Next
    className = NZ(pPath(UBound(pPath)))
End Property

Public Property Let className(ByVal iName As String)
On Error Resume Next
    Dim idx As Long: idx = NZ(UBound(pPath) + 1)
    ReDim Preserve pPath(idx): pPath(idx) = iName
End Property

'/**
' * Bei einem Methodengebundenen Logger steht hier der Name der Method
' * @return String
' */
Public Property Get actualMethodeName() As String:              actualMethodeName = pActualMethode: End Property
Public Property Let actualMethodeName(ByVal iName As String)
    pActualMethode = iName
    loggerType = eltMethode
End Property


'/**
' * Gibt einen Clone des aktuelles Objektes zurück
' */
Public Property Get clone() As Log4vba
    Set clone = New Log4vba
    clone.sessionId = Me.sessionId
    clone.debugmode = Me.debugmode
    clone.allTypeNames = Me.allTypeNames
    clone.allTypeSettings = Me.allTypeSettings
    
#If ms_product = C_ACCESS Then
    clone.functionName = Me.functionName
#End If
#If ms_product = C_ACCESS Or ms_product = C_EXCEL Then
    clone.logTable = Me.logTable
#End If
End Property

'/**
' * DebugMode ein/ausschalten
' * @return Boolean
' */
Public Property Get debugmode() As Boolean:                        debugmode = pDebugMode:   End Property
Public Property Let debugmode(ByVal iDebugMode As Boolean):       pDebugMode = iDebugMode:  End Property

'/**
' * Die gesammelten Paramter für ein Logtype
' * @return eTypeSetting
' */
Public Property Get typeSettings(ByVal iLogType As eLogType) As eTypeSetting
    typeSettings = pTypeSettings(iLogType)
End Property
Public Property Let typeSettings(ByVal iLogType As eLogType, ByVal iSetting As eTypeSetting)
    pTypeSettings(iLogType) = iSetting
End Property

Public Property Get allTypeSettings() As eTypeSetting()
    allTypeSettings = pTypeSettings
End Property

Public Property Let allTypeSettings(ByRef iTypeSettings() As eTypeSetting)
    pTypeSettings = iTypeSettings
End Property

Public Property Get allTypeNames() As String()
    allTypeNames = pTypeNames
End Property

Public Property Let allTypeNames(ByRef iAllTypeNames() As String)
    pTypeNames = iAllTypeNames
End Property

'/**
' * Infos über den letzten Eintrag
' */
Public Property Get lastLogType() As eLogType:      lastLogType = pLastAssert.logType:          End Property
Public Property Get lastLogMessage() As String:     lastLogMessage = pLastAssert.logMsg:        End Property
Public Property Get lastLogSource() As String:      lastLogSource = pLastAssert.Source:         End Property
Public Property Get lastLogTimeStamp() As String:   lastLogTimeStamp = pLastAssert.timeStamp:   End Property

#If ms_product = C_ACCESS Then
    '/**
    ' * Externe Public Function pro LogType, welche ausgeführt wird wenn eprOutFunction aktiviert ist
    ' * Es muss eine Funktion und keine Sub sein, denn die Sub kann mit eval() nicht ausgeführt werden
    ' * Die externe Funktion mussso definiert sein. Es können noch weitere optionale Attribute angehängt werden. Es wird nur der erste ausgefüllt
    ' * Public Function myFunction(ByVal iLogType As eLogType, ByVal iText As String)
    ' * @param  String
    ' */
    Public Property Get functionName() As String:               functionName = pFunctionName:       End Property
    Public Property Let functionName(ByVal iName As String):    pFunctionName = iName:              End Property
#End If
#If ms_product = C_ACCESS Or ms_product = C_EXCEL Then
    Public Property Get logTable() As String:                   logTable = pLogTable:               End Property
    Public Property Let logTable(ByVal iName As String):        pLogTable = iName:                  End Property
#End If

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

'/**
' * Den Eintrag standartmässig handeln
' * @param  ErrObject/String
' * @param  eLogType    Typ der gelogt werden doll
' * @param  Long            Error-Nummer
' * @param  String          Name der Methode
' * @param  Array<>         Ein Arry mit den Aufrufparamtern der Method
' * @param  eTypeSetting    Die Setings für diesen Type einmalig übersteuern
' * @return Boolen/String   Rückgabewert für debug.assert oder LogMessage
' */
Public Function assert( _
        ByRef iError As Variant, _
        Optional ByVal iLogType As eLogType = eLogType.[_Default], _
        Optional ByVal iSource As String, _
        Optional ByRef iValueArray As Variant, _
        Optional ByVal iNumber As Long, _
        Optional ByVal iOverwriteSetting As eTypeSetting = eTypeSetting.[_NA], _
        Optional ByVal iDebugValue As Variant _
) As Variant
    Dim item As tItem
    
    'Flags vorbereiten
    Dim isErr As Boolean:   isErr = IsObject(iError)
    Dim srcExt As Boolean:  srcExt = outMethodeDetail(iLogType, eprFrmtSourceExtend) Or andB(iOverwriteSetting, eprFrmtSourceExtend)
    Dim haveSrc As Boolean: haveSrc = (iSource <> Empty)
    
    'Standards festlegen
    If IsMissing(iError) Then iError = Empty
    If IsMissing(iValueArray) Then iValueArray = emptyArrayVariant
    
    'LogType
    item.logType = iLogType
    
    'Source/Methode ermitteln
    item.Source = iSource
    item.path = pPath
    If Not haveSrc And isErr Then
        item.Source = iError.Source
    ElseIf haveSrc And isErr And srcExt Then
        item.Source = iError.Source & "." & iSource
    End If
    
    item.variablen = varArray2String(iValueArray)
    
    'Bei einem MethodeLogger die Source überschreiben
    If pLoggerType = eltMethode Then item.Source = actualMethodeName
    
    'restliche Infos aus einem ErrObject auslesen
    If isErr Then
        item.Description = iError.Description
        item.Number = IIf(iNumber = 0, iError.Number, iNumber)
    Else
        item.Description = iError
        item.Number = iNumber
    End If
    'Die Settings auslesen
    item.setting = IIf(iOverwriteSetting = eTypeSetting.[_NA], typeSettings(iLogType), iOverwriteSetting)
    
    'DebugValue als Zeilearray übergeben
    If Not IsMissing(iDebugValue) Then item.debugText = Split(var2string(iDebugValue, item.setting), vbCrLf)
    
    assert = writeMessage(item, iLogType)
End Function

'/**
' * Stellt die Source inkl. Paramtern als Einzeiler dar
' * @param  Variant
' * @return String
' */
Private Static Function varArray2String( _
        ByRef iValueArray As Variant _
) As String
    Dim args() As Variant
    Dim value As Variant
    If Not IsArray(iValueArray) Then
        args = Array(var2string(iValueArray, eprFrmtJson))
    ElseIf Not UBound(iValueArray) = -1 Then
        ReDim args(UBound(iValueArray))
        Dim i As Long: For i = 0 To UBound(iValueArray)
            ref value, iValueArray(i)
            If IsNumeric(value) Then value = val(value)
            args(i) = var2string(value, eprFrmtJson)
        Next i
    Else
        Erase args
    End If
    varArray2String = join(args, ", ")
End Function

'/**
' * Parst ein Wert in ein String. Wird fpr dieVeranschaulichung des Variabelninhaltes verwednet
' * @param  Variant
' * @param  eTypeSetting      ggf. Information ob mit json oder printR gearbeitet werden soll
' * @return String
' */
Private Function var2string(ByRef iVar As Variant, Optional ByVal iVarPrint As eTypeSetting = -1) As String
    If IsMissing(iVar) Then
        var2string = "Missing"
        Exit Function
    End If
'Rückgabe mit print_r
#If lib_printr_exists Then
    If Not andB(iVarPrint, eprFrmtJson) And Not andB(iVarPrint, eprFrmtNoFormat) Then
        var2string = print_r(iVar, prParamsDefault, prReturn)
        Exit Function
    End If
#End If

'Rückgabe als Json
#If lib_json_exists Then
    If IsArray(iVar) Or TypeName(iVar) = "Collection" Or TypeName(iVar) = "Dictionary" And Not andB(iVarPrint, eprFrmtNoFormat) Then
        var2string = obj2json(iVar, jqmSingleQuote + jqmNoErrorForWrongType)
        Exit Function
    End If
#End If

'Einfache version
    If IsObject(iVar) Then
        On Error Resume Next
            var2string = castSqlString(iVar)
            If Err.Number <> 0 Then
                var2string = "<" & TypeName(iVar) & ">"
            End If
            Err.clear
        On Error GoTo 0
    ElseIf IsArray(iVar) Then
        Dim retArr() As Variant:
        If UBound(iVar) = -1 Then
            retArr = emptyArrayVariant
        Else
            ReDim retArr(LBound(iVar) To UBound(iVar))
            Dim i As Long: For i = LBound(iVar) To UBound(iVar)
                retArr(i) = var2string(iVar(i), iVarPrint)
            Next i
        End If
        var2string = "[" & join(retArr, ",") & "]"
    Else
        var2string = castSqlString(iVar)
    End If
End Function

'/**
' * Die Meldung in die verschieden Kanäle absetzen
' * @param  tItem
' * @param  eLogType
' * @return Boolen/String  Rückgabewert für debug.assert oder LogMessage
' */
Private Function writeMessage( _
        ByRef ioItem As tItem, _
        Optional ByVal iLogType As eLogType = eLogType.[_NA] _
) As Variant
    ioItem.timeStamp = Now
    ioItem.logMsg = createLogText(ioItem, iLogType)
    'Logfile
    If andB(ioItem.setting, eprOutLogFile) Then logFileStream.writeLine ioItem.logMsg
    'Konsole (Direktfenster)
    If andB(ioItem.setting, eprOutConsole) Then Debug.Print ioItem.logMsg
    'MsgBox
    If andB(ioItem.setting, eprOutMsgBox) Then writeMessage = dialog(ioItem, iLogType)
    'Assert-Wert
#If ms_product = C_ACCESS Then
    'externe Funktion ausführen
    If andB(ioItem.setting, eprOutFunction) And functionName <> Empty Then writeMessage = writeToFunction(ioItem, iLogType)
#End If
#If ms_product = C_ACCESS Or ms_product = C_EXCEL Then
    'Logtabelle abfüllen
    If andB(ioItem.setting, eprOutTable) And pLogTable <> Empty Then writeToTable ioItem, iLogType
#End If
    'Letzter Eintrag behalten
    pLastAssert = ioItem
    'Logtype extra erst am Schluss übernehmen. Bei Thraw und Raise entsprechen ioItem.LogType nicht dem eigentlichen Type
    pLastAssert.logType = iLogType
    If andB(ioItem.setting, eprReturnMsg) Then writeMessage = ioItem.logMsg
    RaiseEvent log(ioItem.logType, ioItem.logMsg)
    If andB(ioItem.setting, eprReturnAssert) And Not andB(ioItem.setting, eprOutMsgBox) Then writeMessage = False
    DoEvents
End Function



#If ms_product = C_ACCESS Then

    '/**
    ' * Schreibt die Meldung miteiner externen Funktion
    ' * @param  tItem
    ' * @param  eLogType
    ' * @return Boolen/String  Rückgabewert für debug.assert oder LogMessage
    ' */
    Private Function writeToFunction( _
            ByRef ioItem As tItem, _
            Optional ByVal iLogType As eLogType = eLogType.[_NA] _
    ) As Variant
        On Error Resume Next
            Dim expr As String: expr = functionName & "(" & iLogType & ", '" & replace(ioItem.logMsg, "'", "''") & "', " & NZ(sessionId, 0) & ")"
            eval expr
            If Err.Number <> 0 Then
                writeToFunction = internalLogger(eprOutFunction).error("Internal Error in Log4vba: Cant run the function:" & vbCrLf & expr)
                Err.clear
            End If
        On Error GoTo 0
    
    End Function
    
    '/**
    ' * Schreibt die Meldung in eine Logtabelle
    ' * @param  tItem
    ' * @param  eLogType
    ' * @return Boolen/String  Rückgabewert für debug.assert oder LogMessage
    ' */
    Private Function writeToTable( _
            ByRef ioItem As tItem, _
            Optional ByVal iLogType As eLogType = eLogType.[_NA] _
    ) As Variant
        On Error Resume Next
        If pLogTable = Empty Then Exit Function
        
        Dim sql As String
        
        If Not logTableExists Then
            sql = "create table [" & pLogTable & "]([LOG_ID] autoincrement , [LOG_SESSION_ID] numeric, [LOG_TIMESTAMP] datetime, [LOG_TYPE] numeric, [LOG_TYPE_TEXT] varchar(20), [LOG_DESCRIPTION] memo, [LOG_SOURCE] varchar(255), [LOG_VARS] memo, [LOG_TEXT] memo, [ERR_NR] numeric, constraint primarykey primary key(LOG_ID));"
            CurrentDb.execute sql
        End If
        
        Dim values() As Variant: values = Array( _
            castSqlString(pSessionId, vbLong), _
            castSqlString(ioItem.timeStamp, vbDate), _
            castSqlString(ioItem.logType, vbInteger), _
            castSqlString(getTypeText(ioItem.logType), vbString), _
            castSqlString(ioItem.Description, vbString), _
            castSqlString(ioItem.Source, vbString), _
            castSqlString(ioItem.variablen, vbString), _
            castSqlString(ioItem.logMsg), _
            castSqlString(ioItem.Number, vbLong) _
        )
    
        sql = "insert into [" & pLogTable & "] ([LOG_SESSION_ID], [LOG_TIMESTAMP], [LOG_TYPE], [LOG_TYPE_TEXT], [LOG_DESCRIPTION], [LOG_SOURCE], [LOG_VARS], [LOG_TEXT], [ERR_NR]) values (" & join(values, ", ") & ");"
        CurrentDb.execute sql
        If Err.Number <> 0 Then
            writeToTable = internalLogger(eprOutTable).error("Internal Error in Log4vba: Logtable [" & pLogTable & "] have the wrong fields. Delete the existing Log-Table")
            Err.clear
        End If
    End Function
#ElseIf ms_product = C_EXCEL Then
    '/**
    ' * Schreibt die Meldung in eine Logtabelle
    ' * @param  tItem
    ' * @param  eLogType
    ' * @return Boolen/String  Rückgabewert für debug.assert oder LogMessage
    ' */
    Private Function writeToTable( _
            ByRef ioItem As tItem, _
            Optional ByVal iLogType As eLogType = eLogType.[_NA] _
    ) As Variant
        Dim logWs As Worksheet
        Dim values() As Variant
        
        On Error Resume Next
        Set logWs = Worksheets(pLogTable)
        On Error GoTo 0
        
        If logWs Is Nothing Then
            Set logWs = Worksheets.add(, Worksheets(Worksheets.count))
            logWs.name = pLogTable
        End If
        array2row logWs.range("A1"), Array("LOG_TIMESTAMP", "LOG_TYPE_TEXT", "LOG_DESCRIPTION", "LOG_SOURCE", "LOG_VARS", "LOG_TEXT", "ERR_NR")
        rows("2:2").insert shift:=xlDown
        array2row logWs.range("A2"), Array(ioItem.timeStamp, getTypeText(ioItem.logType), ioItem.Description, ioItem.Source, ioItem.variablen, ioItem.logMsg, ioItem.Number)
        Cells.EntireColumn.autoFit
    End Function
    
    '/**
    ' * Schreibt ein Array in eine Zeile
    ' * http://excelmontecarlo.com/24a_writing_arrays_to_worksheet.html
    ' * @param  Range
    ' * @param  Array
    ' */
    Private Sub array2row(ByVal iFirstField As range, ByRef iArray As Variant)
        iFirstField.Resize(1, UBound(iArray) + 1) = iArray
    End Sub
#End If

'/**
' * Erstellt einen LogText
' *     0:Datum 1:Type 2:Methode - 3:[#Nummer] 4:Description 5:(Variablen)
' * @param  tItem
' * @param  eLogType
' * @return String
' */
Private Function createLogText(ByRef ioItem As tItem, Optional ByVal iLogType As eLogType = ltInfo) As String
    Const C_DATE_SIZE = 22
    Const C_TYPE_SIZE = 10
    Dim sTab As String: sTab = String(C_DATE_SIZE + C_TYPE_SIZE, " ")
    Dim sDate As String, sType As String, sSource As String, sNumber As String, sDescription As String, sVariablen As String

    'Datum
    sDate = lPad(ioItem.timeStamp, C_DATE_SIZE)
    'Type
    sType = lPad(getTypeText(iLogType), C_TYPE_SIZE)
    'Methode
    If Not outMethodeDetail(iLogType, eprFrmtNoSource) Then
        sSource = IIf(ioItem.loggerType = eltMethode, ioItem.Source, ioItem.Source)
        If isClassLogger Then sSource = join(ioItem.path, ".") & sSource
        If Not sSource = Empty Then sSource = sSource & " - "
    End If
    'Number
    If ioItem.Number <> 0 Then sNumber = "[#" & ioItem.Number & "] "
    'Description
    sDescription = ioItem.Description
    'Variablen
    If Not ioItem.variablen = Empty Then sVariablen = " (" & ioItem.variablen & ")"
    'Debugtext: überschreibt Variablen
    If IsArray(ioItem.debugText) Then
        Dim i As Long: For i = LBound(ioItem.debugText) + 1 To UBound(ioItem.debugText)
            ioItem.debugText(i) = sTab & ioItem.debugText(i)
        Next i
        sVariablen = ": " & join(ioItem.debugText, vbCrLf)
    End If
    
    createLogText = sDate & sType & sSource & sNumber & sDescription & sVariablen


End Function

'/**
' * Gibt den Fehler Eintrag als Dialog aus
' * @param  logType
' * @param  VbMsgBoxStyle
' * @return VbMsgBoxResult
' */
Private Function dialog(ByRef ioItem As tItem, ByVal iLogType As eLogType) As Boolean
    Dim style As VbMsgBoxStyle
    Dim result As VbMsgBoxResult
    Dim Msg As String

    Msg = ioItem.Description
    Select Case iLogType
        Case ltInfo:    style = vbInformation
        Case ltWarning: style = vbExclamation
        Case ltError:   style = vbCritical
    End Select
    If outMethodeDetail(iLogType, eprReturnAssert) Then
        style = style + vbYesNo
        result = vbNo
        Msg = Msg & vbCrLf & vbCrLf & "Stop for Debug?"
    Else
        style = style + vbOKOnly
        result = vbOK
    End If

    If ioItem.Number <> 0 Then Msg = "[" & ioItem.Number & "] " & Msg
    If ioItem.Source <> Empty Then Msg = ioItem.Source & vbCrLf & vbCrLf & Msg
    dialog = (result = MsgBox(Msg, style, getTypeText(iLogType)))
End Function

'/**
' * Gibt den Text zum Type zurück
' * @param  eLogType
' * @return String
' */
Private Function getTypeText(ByVal iLogType As eLogType) As String
    getTypeText = pTypeNames(iLogType)
'    Select Case iLogType
'        Case ltDebug:           getTypeText = "DEBUG"
'        Case ltInfo:            getTypeText = "INFO"
'        Case ltWarning:         getTypeText = "WARNING"
'        Case ltError:           getTypeText = "ERROR"
'        Case eLogType.[_DEBUG]: getTypeText = "DEBUG"
'        Case Else:              getTypeText = "N/A"
'    End Select
End Function


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

#If ms_product = C_ACCESS Then
    '/**
    ' * Information, ob die LogTabelle exiistiert
    ' * @return Boolean
    ' */
    Private Property Get logTableExists() As Boolean
        Dim dummy As tableDef: Set dummy = CurrentDb.TableDefs(pLogTable)
        logTableExists = Err.Number = 0
    End Property
#End If

'/**
' * Gibt einen Logger zurück, um interneFehler zu loggen
' * @param  eTypeSetting    Angabe, ob ein Output unterdrückt werden soll
' * @return Log4vba
' */
Private Property Get internalLogger(Optional ByVal iOutSetting As eTypeSetting) As Log4vba
    Set internalLogger = Me.clone
    Select Case iOutSetting
#If ms_product = C_ACCESS Then
        Case eprOutFunction:    internalLogger.functionName = Empty
        Case eprOutTable:       internalLogger.logTable = Empty
#End If
    End Select
End Property

'/**
' * Setzt oder entfernt einen Paramter
' * @param  eLogType
' * @param  Boolean
' */
Private Property Get outMethodeDetail(ByVal iLogType As eLogType, ByVal iParam As eTypeSetting) As Boolean
    outMethodeDetail = andB(pTypeSettings(iLogType), iParam)
End Property
Private Property Let outMethodeDetail(ByVal iLogType As eLogType, ByVal iParam As eTypeSetting, ByVal iValue As Boolean)
    If Not andB(pTypeSettings(iLogType), iParam) And iValue Then
        pTypeSettings(iLogType) = pTypeSettings(iLogType) + iParam
    ElseIf andB(pTypeSettings(iLogType), iParam) And Not iValue Then
        pTypeSettings(iLogType) = pTypeSettings(iLogType) - iParam
    End If
End Property

'/**
' * Gibt einen Textstream auf die Log-Datei zurück
' * @return   TextStream
' */
Private Property Get logFileStream() As Object
    Const ForAppending = 8
    Static fso As Object
    Static stream As Object
    If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
    If stream Is Nothing Then
        Dim logFilePath As String
       
#If ms_product = C_ACCESS Then
        logFilePath = CurrentDb.name
#ElseIf ms_product = C_EXCEL Then
        logFilePath = ActiveWorkbook.path
#End If
        logFilePath = fso.BuildPath(fso.GetParentFolderName(logFilePath), fso.GetBaseName(logFilePath) & ".log")
        Set stream = fso.OpenTextFile(logFilePath, ForAppending, True)
    End If
    Set logFileStream = stream
End Property


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

'/**
' * Aus SQLScript kopiert
' * Gibt einen SQL-String anhand des Datentyp zurück
' * @param  Variant         Daten
' * @param  VBA.VbVarType   Datentype aus VarType() überschreiben
' * @return String          SQL-String
' */
Private Function castSqlString(ByVal iValue As Variant, Optional ByVal iVarType As VbVarType = -1) As String
    If IsNull(iValue) Then
        castSqlString = "NULL"
        Exit Function
    End If
    Select Case IIf(iVarType = -1, varType(iValue), iVarType)
        Case vbDate:        castSqlString = "#" & format(iValue, "MM-DD-YYYY HH:NN:SS") & "#"
        Case vbNull:        castSqlString = "NULL"
        Case vbEmpty:       castSqlString = "''"
        Case vbBoolean:     castSqlString = UCase(CStr(CBool(iValue))) 'CStr(CInt(iValue))
        Case vbLong, vbInteger, vbByte, vbDouble, vbDecimal, vbSingle, vbCurrency
                            castSqlString = CStr(iValue)
        Case Else:          castSqlString = "'" & replace(CStr(iValue), "'", C_SQL_QUOTA_REPLACE) & "'"
    End Select
End Function

'/**
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/pad
' * Gibt den String iString zurück. Dieser wurde nach links mit dem String iPadString auf eine Länge von iLen Zeichen aufgefüllt.
' * Wenn iString länger als iLen ist, wird der Rückgabewert auf iLen Zeichen gekürzt.
' * @param  String
' * @param  Integer     Neue Länge
' * @param  String      Zeichen mit dem verlängert wird
' * @return Erweiterter oder gekürzter String
' */
Private Function lPad( _
        ByVal iString As String, _
        ByVal iLen As Integer, _
        Optional ByVal iPadString As String = " " _
) As String
    lPad = Left(iString, iLen)
    lPad = lPad & String(iLen - Len(lPad), iPadString)
End Function

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

'/**
' * 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 Grössten aus einer unbestimmten Menge von Werten zurück
' * @link   http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/greatest
' * @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

'   /**
'    * IsEmptyArray
'    * @param   Array
'    * @return  true if Array is not initialized
'    */
Private Function isEmptyArray(ByVal iArray As Variant) As Boolean
  If IsArray(iArray) Then
    isEmptyArray = IsMissing(iArray)
  Else
    Err.Raise 13 'Type mismatch'
  End If
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