VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Iterator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : Iterator.cls
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/classes/iterator
'Environment  : VBA 2007+
'Version      : 2.12.3
'Name         : Iterator
'Author       : Stefan Erb (ERS)
'History      : 28.02.2014 - ERS - Creation
'               ...
'               10.11.2017 - ERS - Kleine Korrekturen
'               21.11.2017 - ERS - Neue Methoden offset() und offset1()
'               18.12.2017 - ERS - Indexzugriff über Key ermöglicht
'               16.07.2018 - ERS - isEmpty() für Arrax neu mit isMissing gelöst
'               01.03.2019 - ERS - Fehler beim add() ausgemerzt
'               04.09.2019 - ERS - Array() durch emptyArrayVariant() ersetzt
'-------------------------------------------------------------------------------
Option Explicit

'-------------------------------------------------------------------------------
' -- ! SETTINGS !
'-------------------------------------------------------------------------------
'/**
' * In Excel funktionieren Events nicht. Auch der NZ() gibt es dort nicht.
' * Darum hier angeben ob es sich um MS Access handelt oder eben nicht. Leider gibts datzu keine Systemvariable
' * Es gibt auch Codeabschnitte die nur in Access (oder mit einer Referenz auf Access) funktionieren
' */
#Const isAccess = True

'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
'/**
' * Parameter zur Steuerung des Verhalten des Iterators
' * Die einzelnen Parameter sind mit + kombinierbar
' */
Public Enum itParams
    itNone = 0                          'Kein Parameter hat gültigkeit
    itNothingAsEmptyList = 2 ^ 0        'Leerer String, Nothing, Empty, Null wird als leere Liste akzeptiert und wirft kein Fehler
    itListNextNoParamsAsToNext = 2 ^ 1  'Wenn bei listNext keine Parameter angeben werden, einfach eins vorrücken.
    itErrorAtEmptyList = 2 ^ 2          'Fehler generieren, wenn die iListe leer ist
    itDaoValue = 2 ^ 3                  'Field-Value anstelle von Field ausgeben
    itIndexInsteadKey = 2 ^ 4           'Gibt bei den toX() Funktionen den Index anstelle des Keys zurück
    itNotOverwriteMap = 2 ^ 5           'Überschreibt den Iterator nicht, wenn dieser bereits initialisiert ist.
    itKeyIgnoreCase = 2 ^ 6             'IgnoriertGross/Kleinschreibungder keys.
    itDefault = itListNextNoParamsAsToNext + itKeyIgnoreCase
End Enum

'/**
' * Information, ob sich der Iterator gerade in einem Loop befindet und wenn ja, in welche Richtung
' * Steuert das verhalten bei remove()
' */
Public Enum itLoopDirection
    itDefaultDirection = 0
    itDirect = 2 ^ 0
    itToNext = 2 ^ 1
    itToPrev = 2 ^ 2
End Enum

'/**
' * Typ des Keys/Index
' */
Public Enum itKeyType
    itDefaultKeyType = 0
    itIndex = 2 ^ 0
    itKey = 2 ^ 1
    itAbsolutePosition = 2 ^ 2
End Enum

'/**
' * Enum ADODB.PositionEnum
' * Hier gespiegelt, falls ADODB nicht referenziert ist
' */
Public Enum PositionEnum
    adPosUnknown = -1
    adPosBOF = -2
    adPosEOF = -3
End Enum

'/**
' * Public Event, wenn EOF erreicht wird
' */
#If isAccess Then
    Public Event arriveEndOf(pos As PositionEnum)
#End If




'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------
Private Const IT_ERR_NO_PARAMS = vbObjectError + 5000           'Bei einer list-Funktion wurden keine Parameter übergeben
Private Const IT_ERR_NOT_SUPPORTED_MAP = vbObjectError + 5001   'Ist keine bekannte Liste
Private Const IT_ERR_EMPTY_MAP = vbObjectError + 5002           'Die Liste ist leer
Private Const IT_ERR_KEY_NOT_FOUND = vbObjectError + 5003       'Der angegebene Key wurde nicht in der Liste gefunden
Private Const IT_ERR_DUPLICATE_KEY = vbObjectError + 5004
Private Const IT_ERR_MISSING_KEY = vbObjectError + 5005


'/**
' * Interne Typenunterscheidung der Liste
' */
Private Enum itListType
    itArray
    itDictionary
    itCollection
    itMatchCollection
    itMatch
    itQueryDef
    itTableDef
    itDaoRecordset
    itDaoFields
    itDaoField
    itProperties
    itNoList
    itExcelWoorkbook
    itExcelSheets
    itFSOFolder
    itFSOFolders
    itSqlString
    itIndex0List    'Einfache Liste, die bei 0 beginnt
    itIndex1List    'Einfache Liste, die bei 1 beginnt
End Enum

Private Enum baValueType
    baBitPosition = 1       'Der Array-Value beinhaltet die Bitpositionen von allen gesetzten Bit. Bei nicht gesezten Bits ist der Value false (also -1)
    baBit = 2               'Gibt das Bit an der entsprechenden Position zurück. 0 oder 1
    baValue = 3             'Gibt den Wert des Bits zurück: 2^Bitposition
End Enum

Private Enum incType
    itPreIncrement = 0    '++1
    itPostIncrement = 1   'i++
    itPreDecrement = 2    '--i
    itPostDecrement = 3   'i--
End Enum

'/**
' * Paramter um das Verhalten von CStrF zu steuern
' */
Private Enum itToStringParams
    itNon = 0                      'Kein Parameter aktiv
    itListAsJson = 2 ^ 0           'Falls die Library lib_json installiert ist, die Listen (Array, Dictionary etc) als Json-String zurückgeben. Ansonsten als Werteliste mit Komma getrennt
    itRegExpOnlyPattern = 2 ^ 1    'Bei einem Regexp nur den Pattern zurückgeben
    itNullAsEmpty = 2 ^ 2          'Null und Nothing als Empty zurückgeben
    itNotCastableToError = 2 ^ 3   'Wenn etwas nicht geparst werden kann, dann wird ein Error geworfen. Ansonsten kommt der Text #TypeName zurück (zB. #Form)
    
    itIsSubItem = 2 ^ 9            'Wird nur Intern benutzt
End Enum

'/**
' * Paramter um das Verhalten von CStrF zu steuern
' */
Private Enum csfParams
    csfNon = 0                      'Kein Parameter aktiv
    csfListAsJson = 2 ^ 0           'Falls die Library lib_json installiert ist, die Listen (Array, Dictionary etc) als Json-String zurückgeben. Ansonsten als Werteliste mit Komma getrennt
    csfRegExpOnlyPattern = 2 ^ 1    'Bei einem Regexp nur den Pattern zurückgeben
    csfNullAsEmpty = 2 ^ 2          'Null und Nothing als Empty zurückgeben
    csfNotCastableToError = 2 ^ 3   'Wenn etwas nicht geparst werden kann, dann wird ein Error geworfen. Ansonsten kommt der Text #TypeName zurück (zB. #Form)
    
    csfIsSubItem = 2 ^ 9            'Wird nur Intern benutzt
End Enum

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 map                         As Variant      'Die Liste selber
Private uKeys                       As Object       'Übersetzung der Keys. Dict(KEY := Key)
Private forEachCollection           As Collection   'Für den ForEach braucht es leider eine Collection-Class
Private listType                    As itListType   'Typ der Liste
Private pos                         As Long         'Absolute Position, beginnend bei 0
Private myKeys()                    As Variant      'Auflistung der Keys. Wird nur bei Dictionaries, DAO.Fields und Properties gebraucht
Private delta                       As Long         'Index-Abweichung des ersten Indexes zu 0: Index = pos + delta
Private cnt                         As Long         'Anzahl Einträge
Private myParams                    As itParams     'Parameters
Private loopDirection               As itLoopDirection
Private keyType                     As itKeyType
Private flagIsInitialized           As Boolean
Private pUid                        As Variant


'-------------------------------------------------------------------------------
' -- COLLECTION METHODES ---
' http://msdn.microsoft.com/en-us/library/aa262338%28v=vs.60%29.aspx
'-------------------------------------------------------------------------------

'/**
' * Der NewEnum wird für die For Each.. Next Schleife verwendet
' *
' * Diese Funktion hat das Attribut "'Attribute NewEnum.VB_UserMemId = -4"
' * !! Diese Iterierung hat keinen Einfluss auf die aktuelle Position !!
' *
' * @return Das nächste element
' */
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = forEachCollection.[_NewEnum]
End Function


'/**
' * Entspricht dem item()-Befehl der Listenobjekte ode dem instance() der Klasse.
' * Alle 3 Propert-Funktionen haben das versteckte Attribut "Attribute item.VB_UserMemId = 0"
' * Dadurch kann mittels it(1), it("MyFeild"), it!MyField etc darauf zugegriffen werden.
' *
' * !! Das Verhalten dieser Funktion ist NICHT standartisiert. Sie entspricht dem entsprechenden Verhalten der Source !!
' *
' *     node = it(index)
' *     node = it(key)
' *     node = it!key
' *     node = it.item(index)
' *     node = it.item(key)
' *     iterator = Iterator(Recordset/Array etc.)
' *
' * @param  Variant Index/Key
' * @return Variant Value/Iterator
' */
Public Property Get item(ByVal iIndex As Variant) As Variant
Attribute item.VB_UserMemId = 0
'Attribute item.VB_UserMemId = 0
    'Falls noch keine Liste Initialisiiert ist, dann gilt der Aufruf als Iterator.instance
    If Not isInitialized Then
        Set item = Iterator.instance(iIndex)
        Exit Property
    End If
    
    Select Case listType
        Case itDaoFields, itDaoRecordset:       'Bei FieldListen je nach Parameter das Field oder den Value ausgeben
            ref item, IIf((myParams And itDaoValue), map(iIndex).value, map(iIndex))
        Case itDictionary:                      'Bei Dictionaries über den Key zugreiffen
            If IsNumeric(iIndex) Then
                ref item, map(myKeys(iIndex))
            ElseIf andB(params, itKeyIgnoreCase) Then
                ref item, map(uKeys(UCase(iIndex)))           'Dictionary mit Keys.
            Else
                ref item, map(iIndex)
            End If
        Case Else:
            ref item, forEachCollection(iIndex)
            'ref item, map(iIndex)
    End Select
End Property

'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
Public Function instance( _
        ByRef iList As Variant, _
        Optional ByVal iParams As itParams = itDefault _
) As Iterator
    Set instance = New Iterator
    instance.initialize iList, iParams
End Function

'/**
' * Initialisuert den Iterator
' * @param  Variant     Die Liste, über welche Iteriert werden soll
' * @param  itParams    Parameters
' * @return Boolean     true: iList ist eine Liste und hat Werte
' */
Public Function initialize( _
        ByRef iList As Variant, _
        Optional ByVal iParams As itParams = itDefault _
) As Boolean

On Error GoTo Err_Handler

    If flagIsInitialized And andB(iParams, itNotOverwriteMap) <> 0 Then Resume Exit_Handler

    Me.params = iParams

    'Art der Liste ermitteln
    listType = getListType(iList)
    'Spezialfälle
    If listType = itNoList And paramNothingAsEmptyList Then  'Leer -> Leerer Array
        iList = emptyArrayVariant()
    ElseIf listType = itNoList Then                             'Leer -> Fehler
        Err.Raise IT_ERR_NOT_SUPPORTED_MAP, "initialize", "Unknow List type: " & TypeName(iList)
#If isAccess Then
    ElseIf listType = itSqlString Then                          'String -> DAO.Recodset mit iList als SQL
        Dim db  As Dao.Database:    Set db = CurrentDb
        Set iList = CurrentDb.openRecordset(iList, dbOpenSnapshot, dbReadOnly)
        listType = itDaoRecordset
        Set db = Nothing
    ElseIf listType = itQueryDef Or listType = itTableDef Then                          'String -> DAO.Recodset mit iList als SQL
        Set iList = iList.openRecordset
        listType = itDaoRecordset
#End If
    End If

    ref map, iList                      'Liste übernehmen
    delta = 0                           'Index = AbsolutPosition + delta

SPEZ:
    'Spezialsettings der einzelnen ListenTypen
    Select Case listType
        'Array: Der Delta muss je nach lbound() angepasst werden
        Case itArray:
            On Error Resume Next
            delta = LBound(map)         'Der Array beginnt bei lbound(list) zu zählen
            If Err <> 0 Then delta = 0
            Err.clear
            On Error GoTo Err_Handler
        'Collection: Die Collection beginnt bei 1 mit Zählen
        Case itCollection, itIndex1List:      delta = 1
        'Match: Bei Matches ist die Liste im Attribut SubMatches versteckt. Der Rest vom Match interessiert uns nicht weiter
        Case itMatch:           ref map, iList.subMatches
        'Field: Bei einem Field interessieren uns die Properties
        Case itDaoField:
            listType = itProperties                         'ListType als itProperties setzen
            ref map, iList.properties                       'Properties als map übernehmen
            GoTo SPEZ                                       'Die Definition für itProperties übernhemen
        'Excel Workbook: Die Sheets extrahieren
        Case itExcelWoorkbook:
            listType = itExcelSheets                        'WorkSheet als Sheets setzen
            ref map, iList.Sheets                           'Sheets als map übernehmen
            GoTo SPEZ                                       'Die Definition für itExcelSheets übernhemen
        'Folder: Bei einem Folder interessieren die SubFolders und die Files
        Case itFSOFolder:
            listType = itCollection
            Set map = New Collection
            Dim f As Object: For Each f In iList.SubFolders
                map.add f
            Next
            For Each f In iList.Files
                map.add f
            Next
            GoTo SPEZ
        'Folders: Eine Liste von Folders. zB aus SubFolders(). Da man nicht über Index auf die einzelnen Folder zugreiffen kann, das ganze in eine Collection schreiben
        Case itFSOFolders
            listType = itCollection
            Set map = New Collection
            Dim sf As Object: For Each sf In iList
                map.add sf
            Next
            GoTo SPEZ
        'Dictionary: Das Dictionary clonen
        Case itDictionary:
            Set uKeys = CreateObject("scripting.Dictionary")
            Dim key As Variant: For Each key In map.keys
                uKeys.add UCase(key), key
            Next key
        'BEid en ExcelSheets das Dleta um eins versetzen
        Case itExcelSheets:     delta = 1
        Case itNoList:          Err.Raise IT_ERR_NOT_SUPPORTED_MAP, "Iterator.init", "Parameter is not a supported map"
    End Select

    cnt = count                         'Count  speichern
    createKeyList                       'Keys erstellen
    Call reset                          'Den Zeiger auf BOF setzen

    If Me.isEmpty And paramErrorAtEmptyList Then Err.Raise IT_ERR_EMPTY_MAP, "Iterator.init", "Empty Map"

    recalcForEachCollection

    flagIsInitialized = True
    'initialize = Not Me.isEmpty

Exit_Handler:
    Exit Function
Err_Handler:
    Err.Raise Err.Number, Err.source, Err.Description, Err.HelpContext, Err.HelpContext
    Resume Exit_Handler
    Resume
End Function

'/**
' * Initialisiert den Iterator und gibt gleich eine Referenz darauf zurück
' * @param  Variant     Die Liste, über welche Iteriert werden soll
' * @param  itParams    Parameters
' * @return Boolean     true: iList ist eine Liste und hat Werte
' */
Public Function create( _
        ByRef iList As Variant, _
        Optional ByVal iParams As itParams = itDefault + itNotOverwriteMap _
) As Iterator
    If Not flagIsInitialized Or andB(iParams, itNotOverwriteMap) = 0 Then initialize iList, iParams
    Set create = Me
End Function

'/**
' * Geht zum nächsten Datensatz. Der Key und der Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toNext( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = pos + 1
    toNext = Not EOF:   If Not toNext Then raiseEndOf (adPosEOF): Exit Function
    keyOrIndex oKey
    getCurrent oItem
    loopDirection = itToNext
End Function

'/**
' * Geht zum nächsten Datensatz. Der Key und er Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toPrev( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = pos - 1
    toPrev = Not BOF:   If Not toPrev Then raiseEndOf (adPosBOF): Exit Function
    keyOrIndex oKey
    getCurrent oItem
    loopDirection = itToPrev
End Function

'/**
' * Geht zum ersten Datensatz.
' * Vorsicht, während reset() eins vor den ersten Datensatz geht, geht toFirst() bereits auf den ersten Datensatz
' * Somit ists das eigentlich reset()+toNext()
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toFirst( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = 0
    toFirst = Not EOF:   If Not toFirst Then raiseEndOf (adPosEOF): Exit Function
    keyOrIndex oKey
    getCurrent oItem
    loopDirection = itDirect
End Function

'/**
' * Geht zum nächsten Datensatz. Der Key und er Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toLast( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = cnt - 1
    toLast = Not BOF:   If Not toLast Then raiseEndOf (adPosBOF): Exit Function
    keyOrIndex oKey
    getCurrent oItem
    loopDirection = itDirect
End Function

'/**
' * Geht zu einer spezifischen Position (begnnt bei 0). Der Key und der Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Long        Absolute Position. Zwischen 0 und Count-1
' * @param  Variant     Key oder index des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toPosition( _
        ByVal iAbsolutPosition As Long, _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = iAbsolutPosition
    toPosition = Not BOF And Not EOF
    If Not toPosition Then raiseEndOf (adPosUnknown): Exit Function
    keyOrIndex oKey
    getCurrent oItem
    loopDirection = itDirect
End Function

'/**
' * Geht zu einem spezifischen Key. Der Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder index des Items (je nach Item)
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toKey( _
        ByRef iKey As Variant, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    Dim pPos As Long
    'Die Position ermitteln
    Select Case listType
        Case itDictionary, itDaoFields, itProperties, itExcelWoorkbook:
            pPos = posFromKey(iKey)
        Case Else:
            pPos = iKey - delta
    End Select
    'Mittels toPosition zur Position springen
    toKey = toPosition(pPos, , oItem)
    getCurrent oItem
    loopDirection = itDirect
End Function

'/**
' * Versetzt die Position
' * @param  Long        Versatz
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
' */
Public Function offset( _
        ByVal iStep As Long, _
        Optional ByRef oKey As Variant, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = pos + iStep
    
    offset = Not BOF:   If Not offset Then raiseEndOf (adPosBOF): Exit Function
    offset = Not EOF:   If Not offset Then raiseEndOf (adPosEOF): Exit Function
    
    keyOrIndex oKey
    getCurrent oItem
End Function


'/**
' * Rückt den Zeiger um Eins vor und gibt die Elemente einer Unterliste aus.
' * @paramArray Variant    Auflistung der Variablen, die abgefüllt werden
' * @return     EOF
' */
Public Function listNext( _
        ParamArray oParams() As Variant _
) As Boolean
    Dim aParams()   As Variant: aParams = oParams


    'Wenn keine Parameter übergeben werden, das ganze abbrechen.
    If UBound(oParams) = -1 And Not Me.paramListNextNoParamsAsToNext Then
        Err.Raise IT_ERR_NO_PARAMS, "Iterator.listNext", "no Parametes defined"
    End If

    listNext = toNext()
    listNext = listArray(aParams)
    If Not listNext Then Exit Function  'SubItem ist keine gültige Liste -> Exit
    Dim i As Long:  For i = 0 To UBound(oParams)
        If listType = itDaoRecordset And Me.paramDaoValue Then
            ref oParams(i), aParams(i).value
        Else
            ref oParams(i), aParams(i)
        End If
    Next i
    loopDirection = itDirect
End Function

'/**
' * Ggibt die Elemente der aktuellen Unterliste aus.
' * @paramArray Variant    Auflistung der Variablen, die abgefüllt werden
' * @return EOF & BOF
' */
Public Function List( _
        ParamArray oParams() As Variant _
) As Boolean
    Dim aParams()   As Variant: aParams = oParams

    'Wenn keine Parameter übergeben werden, das ganze abbrechen.
    If UBound(oParams) = -1 Then Err.Raise IT_ERR_NO_PARAMS, "Iterator.listNext", "no Parametes defined"

    List = listArray(aParams)
    'Parameter zurückschreiben
    Dim i As Long:  For i = 0 To UBound(oParams)
        oParams(i) = aParams(i)
    Next i
End Function

'/**
' * Setzt den pos auf den Start-1 zurück, so dass bei einem toNext() der erste Datensatz kommt
' */
Public Sub reset()
    pos = -1
    loopDirection = itDirect
End Sub

'/**
' * Setzt den pos 1 nach dem Ende
' */
Public Sub toEOF()
    pos = Me.count
    loopDirection = itDirect
End Sub

'/**
' * Extrahiert die Keys in eine Liste. Die Liste kann vom Type Array, Collection oder Dictionary sein
' * @param  Variant     Liste in welche die Keys extrahiert werden soll
' * @param  Variant     Bei einem Dictionary kann ein Default-Value mitgegeben werden. In Dem Fall wird der Key auch als Key in das Dictionary eingetragen
' * @return Boolean     Angabe, ob das extrahieren erfolgreich war
' */
Public Function extractKeysTo(ByRef oList As Variant, Optional ByVal iDicDefaultValue As Variant = "NO_DEFAULT") As Boolean
    Dim i As Long

    If Not isEmpty Then
        Select Case getListType(oList)
            Case itArray:
                oList = myKeys
                extractKeysTo = True:   Exit Function
            Case itCollection:
                For i = LBound(myKeys) To UBound(myKeys)
                    oList.add myKeys(i)
                Next i
                extractKeysTo = True:   Exit Function
            Case itDictionary:
                For i = LBound(myKeys) To UBound(myKeys)
                    If iDicDefaultValue = "NO_DEFAULT" Then
                        oList.add , myKeys(i)
                    Else
                        oList.add myKeys(i), iDicDefaultValue
                    End If
                Next i
                extractKeysTo = True:   Exit Function
        End Select
    End If
    extractKeysTo = False
End Function

'/**
' * Entfernt ein Eintrag aus der Liste
' * Wenn kein Key oder Index angegeben wird, dann wird der aktuelle Eintrag gelöscht.
' * Wird ein Key oder Index mitgegeben, dann wird der entsprechende Eintrag gelöscht.
' * !Vorsicht:  Arrays sind leider nicht sauber referenziert. Damit hat remove im Gegensatz zu Collection und Dictionary
' *             keinen direkten Einfluss auf die Originalliste. Man kann aber mittels .source auf die angepasste Liste
' *             des Iterators zugreifen
' * @param  Variant         Key, Index der Liste oder nix. Index entspricht dem OriginalIndex. Bei nix wird der aktuelle Eintrag entfernt
' * @param  itLoopDirection Bei einem normalen Loop, wird die absolute Position um eins reduziert, damit auch im Loop über toNext()
' *                         Einträge entfernt werden können. Dieses Verhalten kannhier überschriebenwerden
' * @return Boolean         Flag, ob der Eintrag entfernt wurde oder nicht
' */
Public Function remove( _
        Optional ByRef iKeyOrIndex As Variant = Null, _
        Optional ByVal iKeyType As itKeyType = itDefaultKeyType, _
        Optional ByVal iLoopDirection As itLoopDirection = itDefaultDirection _
) As Boolean
    'Wenn die Liste leer ist, abbrechen
    If isEmpty Then Exit Function

    Dim removeKey   As Variant:                 ref removeKey, IIf(IsNull(iKeyOrIndex), key, getKey(iKeyOrIndex))
    Dim removeIndex As Long:                    removeIndex = getIndex(removeKey)
    Dim actLoopDirection As itLoopDirection:    actLoopDirection = IIf(iLoopDirection = itDefaultDirection, loopDirection, iLoopDirection)

    'Wenn die Position ausserhalb der Daten ist, abbrechen
    
    If removeIndex < firstIndex And lastIndex < removeIndex Then Exit Function

    'Je nach Listentyp den aktuellen Eintrag entfernen
    Select Case listType
        Case itDictionary:      map.remove removeKey            'item entfernen
        Case itCollection:      map.remove removeKey:           'item entfernen
        Case itArray:           deleteFromArray map, removeKey  'item entfernen
        'Für den aktuellen Type ist Remove noch nicht definiert
        Case Else:              Err.Raise IT_ERR_NOT_SUPPORTED_MAP, , "function not supportet for this listtype"
    End Select

    'key-Liste nachführen
    If isKey(removeKey) Then
        deleteFromArray myKeys, removeIndex     'Speziefischen Key aus der Liste löschen
    Else
        ReDim Preserve myKeys(LBound(myKeys) To UBound(myKeys) - 1) 'map ist ohne key - ergo die Keyliste ienfach um eines reduzieren
    End If

    'Cache nachführen
    cnt = count
    recalcForEachCollection

    'Positionskorrektur
    If IsNull(iKeyOrIndex) Then
        Select Case actLoopDirection
            Case itToNext:  pos = pos - 1   'Position um eins zurücksetzen, damit beim nächsten toNext() der neue EIntrag auf der aktuellen Position ausgegeben wird
            Case itToPrev:  'Do nothing
            Case Else:      'Do nothing
        End Select
        loopDirection = actLoopDirection
    End If

    remove = True
End Function

'/**
' * Fügt ein Node der Liste hinzu
' * @param  Variant     Neuer Node
' * @param  Variant     Key oder Index. Der Key wird auch zurückgegeben
' * @return Bollean
' */s
Public Function add( _
        ByRef iItem As Variant, _
        Optional ByRef ioKeyOrIndex As Variant = Null _
) As Boolean
    Dim newKey      As Variant
    Dim newIndex    As Long

    If keyType = itKey Then
        'Key übernehmen und prüfen
        If IsNull(ioKeyOrIndex) Then Err.Raise IT_ERR_MISSING_KEY, , "List need a key for this item"
        newKey = ioKeyOrIndex
        newIndex = getIndex(newKey)
        If firstIndex <= newIndex And newIndex <= lastIndex Then Err.Raise IT_ERR_DUPLICATE_KEY, , "Key allready exists"
    Else
        'Index übernehmen und prüfen
        If IsNull(ioKeyOrIndex) Then ioKeyOrIndex = lastIndex + 1   'Bei Null, am Ende anfügen
        newIndex = ioKeyOrIndex
        If newIndex > lastIndex + 1 Then newIndex = lastIndex + 1   'Wenn der neue Index zu hoch ist, am Ende anfügen
        If newIndex < firstIndex Then Err.Raise IT_ERR_KEY_NOT_FOUND, , "Index is less then the lowest exist index"
        newKey = newIndex
    End If

    'Item einfügen
    Select Case listType
        Case itDictionary:      map.add newKey, iItem
        Case itCollection:      map.add iItem
                                newIndex = map.count
                                newKey = newIndex
        Case itArray:           addToArray map, iItem, newIndex
        'Für den aktuellen Type ist add() noch nicht definierts
        Case Else:              Err.Raise IT_ERR_NOT_SUPPORTED_MAP, , "function not supportet for this listtype"
    End Select

    'Keys nachführen
    addToArray myKeys, newKey, newIndex
    If Not uKeys Is Nothing Then
        If Not uKeys.exists(UCase(newKey)) Then uKeys.add UCase(newKey), newKey
    End If

    'Cache nachführen
    cnt = count
    recalcForEachCollection

    add = True
    ioKeyOrIndex = newKey
End Function

'-------------------------------------------------------------------------------
'-- Public Aliase
'-------------------------------------------------------------------------------
' Andere Formen der bestehenden Methoden

'/**
' * Analog zu add(). Gibt jedoch den Iterator selber zurück
' * @param  Variant     Neuer Node
' * @param  Variant     Key oder Index. Der Key wird auch zurückgegeben
' * @param  Boolean     Flag ob der Add funktioniert hat
' * @return Iterator
' */
Public Function add1( _
        ByRef iItem As Variant, _
        Optional ByRef ioKeyOrIndex As Variant = Null, _
        Optional ByRef oAdded As Boolean _
) As Iterator
    oAdded = add(iItem, ioKeyOrIndex)
    Set add1 = Me
End Function

'/**
' * Analog zu remove(). Gibt jedoch den Iterator selber zurück
' * @param  Variant         Key, Index der Liste oder nix. Index entspricht dem OriginalIndex. Bei nix wird der aktuelle Eintrag entfernt
' * @param  itLoopDirection Bei einem normalen Loop, wird die absolute Position um eins reduziert, damit auch im Loop über toNext()
' *                         Einträge entfernt werden können. Dieses Verhalten kannhier überschriebenwerden
' * @param  Boolean         Flag, ob der Eintrag entfernt wurde oder nicht
' * @return Iterator
' */
Public Function remove1( _
        Optional ByRef iKeyOrIndex As Variant = Null, _
        Optional ByVal iKeyType As itKeyType = itDefaultKeyType, _
        Optional ByVal iLoopDirection As itLoopDirection = itDefaultDirection, _
        Optional ByRef oRemoved As Boolean _
) As Iterator
    oRemoved = remove(iKeyOrIndex, iKeyType, iLoopDirection)
    Set remove1 = Me
End Function

'/**
' * Analog zu toFirst. Gibt aber den Iterator selber zurück
' * Schiebt den Zeiger ebenfalls um eins vor
' * Der Key und EOF werden als Parameter zurückgegeben
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Current
' * @param  Boolean     EOF
' * @return Variant     Current
' */
Public Function toFirst1( _
        Optional ByRef oKey As Variant, _
        Optional ByRef oValue As Variant, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = toFirst(oKey, oValue)
    Set toFirst1 = Me
End Function

'/**
' * Analog zu toNext. Gibt aber den Iterator selber zurück
' * Schiebt den Zeiger ebenfalls um eins vor
' * Der Key und EOF werden als Parameter zurückgegeben
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Current
' * @param  Boolean     EOF
' * @return Variant     Current
' */
Public Function toNext1( _
        Optional ByRef oKey As Variant, _
        Optional ByRef oValue As Variant, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = toNext(oKey, oValue)
    Set toNext1 = Me
End Function

'/**
' * Analog zu toNext. Gibt aber den neuen current zurück
' * Schiebt den Zeiger ebenfalls um eins vor
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Current
' * @return Iterator
' */
Public Function toKey1( _
        ByRef iKey As Variant, _
        Optional ByRef oValue As Variant, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = toKey(iKey, oValue)
    Set toKey1 = Me
End Function

'/**
' * Analog zu toPosition. Gibt aber den Iterator zurück
' * Geht zu einer spezifischen Position (begnnt bei 0). Der Key und der Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Long        Absolute Position. Zwischen 0 und Count-1
' * @param  Variant     Key oder index des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF

' * @return Iterator
' */
Public Function toPosition1( _
        ByVal iAbsolutePosition As Long, _
        Optional ByRef oKey As Variant, _
        Optional ByRef oValue As Variant, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = toPosition(iAbsolutePosition, oKey, oValue)
    Set toPosition1 = Me
End Function

'/**
' * Geht zum letzten Datensatz. Der Key und er Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Iterator
Public Function toLast1( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = toLast(oKey, oItem)
    Set toLast1 = Me
End Function

Public Function toLeast( _
        Optional ByRef oKey As Variant, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    
    toLeast = Me.isEmpty
    If toLeast Then Exit Function
    
    Dim it As Iterator: Set it = Me.clone
    it.toFirst oKey, oItem
    it.reset
    Dim v As Variant, k As Variant: Do While it.toNext(k, v)
        If NZ(v) < NZ(oItem) Then: oItem = v: oKey = k
    Loop
    Me.toKey oKey
End Function

Public Function toLeast1( _
        Optional ByRef oKey As Variant, _
        Optional ByRef oItem As Variant = Null, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = toLeast(oKey, oItem)
    Set toLeast1 = Me
    If Not oEOF Then Me.toKey oKey
End Function

Public Function toGreatest( _
        Optional ByRef oKey As Variant, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    
    toGreatest = Me.isEmpty
    If toGreatest Then Exit Function
    
    Dim it As Iterator: Set it = Me.clone
    it.toFirst oKey, oItem
    it.reset
    Dim v As Variant, k As Variant: Do While it.toNext(k, v)
        If NZ(v) > NZ(oItem) Then: oItem = v: oKey = k
    Loop
    Me.toKey oKey
End Function

Public Function toGreatest1( _
        Optional ByRef oKey As Variant, _
        Optional ByRef oItem As Variant = Null, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = toGreatest(oKey, oItem)
    If oEOF Then Exit Function
    Set toGreatest1 = Me
    If Not oEOF Then Me.toKey oKey
End Function

'/**
' * Versetzt die Position
' * @param  Long        Versatz
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
' */
Public Function offset1( _
        ByVal iStep As Long, _
        Optional ByRef oKey As Variant, _
        Optional ByRef oItem As Variant = Null, _
        Optional ByRef oEOF As Boolean _
) As Iterator
    oEOF = offset(iStep, oKey, oItem)
    Set offset1 = Me
End Function

'/**
' * Analog zu toNext. Gibt aber den neuen current zurück
' * Schiebt den Zeiger ebenfalls um eins vor
' * Der Key und EOF werden als Parameter zurückgegeben
' * @param  Variant     Key oder pos des Items
' * @param  Boolean     EOF
' * @return Variant     Current
' */
Public Function toNextValue(Optional ByRef oKey As Variant, Optional ByRef oEOF As Boolean) As Variant
    oEOF = toNext(oKey, toNextValue)
End Function

'/**
' * Analog zu toNext. Gibt aber den neuen key zurück
' * Schiebt den Zeiger ebenfalls um eins vor
' * Der Current und dEOF werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Current
' * @param  Boolean     EOF
' * @return Variant     Key
' */
Public Function toNextKey(Optional ByRef oValue As Variant, Optional ByRef oEOF As Boolean) As Variant
    oEOF = toNext(toNextKey, oValue)
End Function


'/**
' * Analog zu toNext. Gibt aber den neuen current zurück
' * Schiebt den Zeiger ebenfalls um eins vor
' * @return Variant
' */
Public Function toKeyValue(ByRef iKey As Variant) As Variant
    toKey iKey, toKeyValue
End Function



'-------------------------------------------------------------------------------
' -- Interface methodes/properties
'-------------------------------------------------------------------------------
#If IFormattable_exists Then
     Private Function IFormattable_cast(iObject As Variant) As IFormattable
    End Function
    
   '/**
    ' * Gibt ein String-Wert des Current zurück
    ' * @return String
    ' */
    Public Property Get toString(Optional ByVal iFormatString As Variant, Optional ByRef iFormatProvider As FormatProvider) As Variant
        If IsObject(iFormatString) Then Set iFormatProvider = iFormatString
        Dim toStringParams As itToStringParams:     toStringParams = itNullAsEmpty + itNotCastableToError
#If lib_json_exists Then
        toStringParams = toStringParams + itListAsJson
#End If
    
    On Error Resume Next
        If Not iFormatProvider Is Nothing Then
            Dim resArr As Variant
             Select Case listType
                Case itListType.itArray: resArr = iFormatProvider.format(map)
            End Select
            toString = cStrF(resArr, toStringParams)
        ElseIf Not IsMissing(iFormatString) Then
            toString = cStrF(map, toStringParams, iFormatString)
        Else
            toString = cStrF(map, toStringParams)
        End If
    End Property

    '/**
    ' * Gibt das Originalobjekt  zurück
    ' * @object
    ' */
    Private Property Get IFormattable_toString(Optional ByVal format As Variant, Optional ByRef iFormatProvider As Object) As String
        IFormattable_toString = toString(format, iFormatProvider)
    End Property
#Else
    '/**
    ' * Gibt ein String-Wert des Current zurück
    ' * @return String
    ' */
    Public Property Get toString(Optional ByVal format As String) As String
        Dim toStringParams As itToStringParams:     toStringParams = itNullAsEmpty + itNotCastableToError
#If lib_json_exists Then
        toStringParams = toStringParams + itListAsJson
#End If
On Error Resume Next
        toString = cStrF(map, toStringParams)
    End Property

#End If

'-------------------------------------------------------------------------------
'-- Private Events
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
    Dim dummy As Variant: dummy = uid(True)
End Sub

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

Private Sub raiseEndOf(pos As PositionEnum)
#If isAccess Then
    RaiseEvent arriveEndOf(pos)
#End If
End Sub

'/**
' * Eintrag aus einem Array entfernen
' */
Private Sub deleteFromArray(ByRef ioArray As Variant, ByVal iIndex As Long)
    Dim idx As Long: For idx = iIndex To UBound(ioArray) - 1
        ioArray(idx) = ioArray(idx + 1)
    Next idx
    ReDim Preserve ioArray(LBound(ioArray) To UBound(ioArray) - 1)
End Sub

'/**
' * Wert zu einem Array hinzufügen
' */
Private Sub addToArray(ByRef ioArray As Variant, ByRef iItem As Variant, ByVal iIndex As Long)
    On Error Resume Next
    If UBound(ioArray) >= 0 Then
        ReDim Preserve ioArray(LBound(ioArray) To UBound(ioArray) + 1)
    Else
        ReDim ioArray(0)
    End If
    If Err.Number <> 0 Then
        ReDim ioArray(0)
    End If
    On Error GoTo 0

    Dim idx As Long: For idx = UBound(ioArray) - 1 To iIndex Step -1
        ioArray(idx + 1) = ioArray(idx)
    Next idx
    ref ioArray(iIndex), iItem

End Sub

'/**
' * Ermittelt die Position eines Keys
' * @param  Variant Key
' * @retrun Long
' */
Private Function posFromKey(ByVal iKey As Variant) As Long
    Dim flag As Boolean
    For posFromKey = 0 To cnt - 1
        If myKeys(posFromKey) = iKey Then
            flag = True
            Exit For
        End If
    Next posFromKey
    If flag = False Then Err.Raise IT_ERR_KEY_NOT_FOUND, "Iterator.toKey", "Key '" & iKey & "' not found in list"
End Function

'/**
' * Gibt eine Referenz auf das Item zurück
' * @param  oItem       Ausgabeparameter: das aktuelle Item
' */
Private Sub getCurrent(Optional ByRef oItem As Variant = Null, Optional ByVal iDaoValue As Boolean = False)
    Dim curr As Variant
On Error GoTo Err_Handler

    Select Case listType
        Case itDaoRecordset:
            map.absolutePosition = Me.absolutePosition
            ref curr, map.fields
        Case itDaoFields:
            ref curr, map(Me.absolutePosition)
        Case Else:
            ref curr, map(Me.key)
    End Select

    ref oItem, curr

    'ggf Value anstelle des Current zurückgeben
    If Me.paramDaoValue Or iDaoValue Then
        Select Case listType
            Case itDaoFields, itMatch, itProperties:
                On Error Resume Next
                ref oItem, curr.value        'Value-Property auslesen
                If Err.Number <> 0 Then value = "#ERR (" & Err.Number & ") " & Err.Description
        End Select
    End If

Exit_Handler:
    Exit Sub
Err_Handler:
    Err.Raise Err.Number, Err.source, Err.Description, Err.HelpContext, Err.HelpContext
    Resume Exit_Handler
    Resume
End Sub

'/**
' * Bei einer Variablenübergabe muss immer unterscheiden werden, ob es ein Objekt ist oder nicht.
' * Diese Sub nimmt einem die Arbeit ab
' * 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
        'Objekte als referenz übergeben
        Set oNode = iNode
    Else
        'Je nach Datentyp der erwartet wird handeln.
        Select Case TypeName(oNode)
            Case "String":      oNode = CStr(NZ(iNode))
            Case "Integer":     oNode = CInt(NZ(iNode))
            Case "Long":        oNode = CLng(NZ(iNode))
            Case "Double":      oNode = CDbl(NZ(iNode))
            Case "Byte":        oNode = CByte(NZ(iNode))
            Case "Decimal":     oNode = CDec(NZ(iNode))
            Case "Currency":    oNode = CCur(NZ(iNode))
            Case "Date":        oNode = CDate(NZ(iNode))
            Case "Nothing":
            Case Else:          oNode = iNode
        End Select
    End If
End Sub

'/**
' * Ermittelt den Type einer Liste
' * @param  Variant     Die Liste
' * @return itListType
' */
Private Function getListType(ByRef iList As Variant) As itListType
    If IsArray(iList) Then
        getListType = itArray
    ElseIf listTypes.exists(TypeName(iList)) Then
         getListType = listTypes(TypeName(iList))
    Else
        getListType = itNoList
    End If
End Function

'/**
' * Ggibt die Elemente der aktuellen Unterliste als Array aus.
' * @param  Array<Variant>    Auflistung der Variablen, die abgefüllt werden
' * @return EOF & BOF
' */
Private Function listArray( _
        ByRef oParams() As Variant _
) As Boolean
    Dim uBnd    As Long:            uBnd = UBound(oParams)

    listArray = Not Me.EOF And Not Me.BOF
    If Not listArray Then Exit Function             'SubItem ist keine gültige Liste -> Exit
    If uBnd = -1 Then Exit Function                 'Keine Parameter zum abfüllen -> Exit

    Dim it As New Iterator: it.initialize Me.current 'Iterator für die Subliste initializieren
    Do While it.toNext
        If uBnd < it.absolutePosition Then Exit Do  'Wenn die Parameter ausgehen, Do verlasssen
        ref oParams(it.absolutePosition), it.current
    Loop: Set it = Nothing
End Function

'/**
' * Gibt je nach Datentyp von oKey und Settings den Key oder den Index zurück
' * Logik:  oKey ist ein Zahl, me.Key nicht -> Index
' *         Der Paramter itIndexInsteadKey wurde gesetzt -> Index
' *         Ansonsten -> Key
' * @param  Referenz auf den Key
' */
Private Sub keyOrIndex(ByRef oKey As Variant)
    If (IsNumeric(oKey) And Not IsNumeric(Me.key)) Or Me.paramIndexInsteadKey Then
        'Index anstelle des Keys
        oKey = Me.absolutePosition
    Else
        'Key
        ref oKey, Me.key
    End If
End Sub

'/**
' * Gint die Information zurück, ob der Zeiger ein Key oder ein Index ist
' * true => Key, false => index
' * @param  Varaint     Zeiger auf d
' * @return Boolean
' */
Private Function isKey(ByRef iKey As Variant) As Boolean
    isKey = andB(keyType, itKey) And Not IsNumeric(iKey)
End Function

'/**
' * Setzt oder entfernt ein Parameter im myParams
' * @param  Boolean     Setzen = true, entfernen = false
' * @param  itParams    Parameter der gesetzt werden soll
' */
Private Sub setParam(ByVal iFlag As Boolean, ByVal iParam As itParams)
    If iParam > 0 Then
        If iFlag And Not andB(myParams, iParam) Then
            'Flag ist auf setzen, Para ist noch nicht gesetzt
            myParams = myParams + iParam
        ElseIf Not iFlag And andB(myParams, iParam) Then
            'Flag ist False, Parameter ist vorerst noch gesetzt
            myParams = myParams - iParam
        End If
    End If
End Sub

'/**
' * erstellt die Key-Liste
Private Sub createKeyList()
    Dim i
    If Not isEmpty Then
        ReDim myKeys(delta To cnt - 1 + delta)
        Select Case listType
            Case itDictionary:
                myKeys = map.keys
                keyType = itKey
            Case itDaoFields, itProperties, itExcelSheets:
                For i = LBound(myKeys) To UBound(myKeys)
                    myKeys(i) = map(i).name
                Next i
                keyType = itKey
            Case Else
                For i = LBound(myKeys) To UBound(myKeys)
                    myKeys(i) = i
                Next i
                keyType = itIndex
        End Select
    End If
End Sub

'/**
' * Die Collection zum Iterieren neu aufbauen
' * Für "For Each value in it" braucht es leider eine Collection
' * Darum wird hier alles in eine eigene Collection abgefüllt
' */
Private Sub recalcForEachCollection()
    Dim bookmark As Long:   bookmark = Me.absolutePosition
    Set forEachCollection = New Collection
    Me.reset
    
    Do While Me.toNext
        forEachCollection.add Me.current, CStr(Me.key)
    Loop
    Me.toPosition bookmark
End Sub

'/**
' * Gibt anhand eines Keys oder Index den key zurück
' * @param  Variant     Key
' * return  Variant
' */
Private Function getKey(ByRef iKeyOrIndex As Variant, Optional ByVal iKeyType As itKeyType) As Variant
    If isKey(NZ(iKeyOrIndex)) Then
        ref getKey, iKeyOrIndex
    Else
        ref getKey, myKeys(NZ(iKeyOrIndex))
    End If
End Function

'/**
' * Gibt anhand eines Keys den Index zurück
' * @param  Variant     Key
' * return  Long
' */
Private Function getIndex(ByRef iKey As Variant, Optional ByVal notFoundGetNextIdx As Boolean = True) As Long
    getIndex = IIf(notFoundGetNextIdx, lastIndex + 1, firstIndex - 1)
    Dim i As Long: For i = LBound(myKeys) To UBound(myKeys)
        If myKeys(i) = iKey Then
            getIndex = i
            Exit For
        End If
    Next i
End Function

'/**
' * Zerlegt eine Nummer ihn ihre Bytes.
' * @param  Long        Die Nummer, welche 'zerlegt' werden soll
' * @param  baValueType Art des Inhalt des Array.
' * @param  Boolean     Flag, ob alle 0er-Bit ausgefiltert werden sollen
' * @return Array(Variant)
' */
Private Function bitArray( _
        ByVal iNumber, _
        Optional ByVal iValueType As baValueType = baBit, _
        Optional ByVal iFilteredOut As Boolean = False _
) As Variant()
    Dim pos         As Long:    pos = 0     'Index
    Dim k           As Long:    k = 0    'Array-Index
    Dim value       As Variant
    Dim bit         As Boolean
    Dim retArray()  As Variant
    Dim bitPos      As Variant

    Do While (2 ^ pos) <= iNumber
        'Der Value ermitteln, der in den Array abgefüllt wird
        bit = CBool(iNumber And 2 ^ pos)
        value = IIf(bit, CLng(2 ^ pos), False)
        bitPos = IIf(bit, pos, False)

        'Prüfen, ob nur die geseztzen Bites ausgegeben werden sollen
        If iFilteredOut And bit Then
            ReDim Preserve retArray(k)
            retArray(k) = Choose(iValueType, bitPos, Abs(bit), value)
            k = k + 1
        ElseIf Not iFilteredOut Then
            ReDim Preserve retArray(pos)
            retArray(pos) = Choose(iValueType, bitPos, Abs(bit), value)
        End If
        pos = pos + 1
    Loop
    bitArray = retArray
End Function

'/**
' * Prüft ein Wert gegen eine Liste von Werten.
' * Bei Objekten geht es nur auf dieselbe Instanz.
' * @param  Variant     Wert der gesucht wird
' * @paramArray         Werte gegen die geprüft wird
' * @return Boolean     Flag ob der Wert gefunden wird
' */
Private Function inSet(ByRef iSearch As Variant, ParamArray iItems() As Variant) As Boolean
    Dim item As Variant: For Each item In iItems
        'Null Vergleich
        If IsNull(iSearch) Or IsNull(item) Then
            inSet = IsNull(iSearch) = IsNull(item)
        'Objekt-Vergleich
        ElseIf IsObject(iSearch) And IsObject(item) Then
            inSet = (iSearch Is item)
        'Value-Vergleich
        ElseIf Not IsObject(iSearch) And Not IsObject(item) Then
            inSet = (NZ(iSearch) = NZ(item))
        End If
        If inSet Then Exit Function
    Next item
End Function

'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
'/**
' * Referent auf die Aktuelle Liste
' */
Public Property Get source() As Variant
    ref source, map
End Property
Public Property Let source(ByRef iList As Variant)  'Setzen für Objekte
    Me.initialize iList
End Property
Public Property Set source(ByRef iList As Variant)  'Setzen für Arrays
    Me.initialize iList
End Property

'/**
' * Gibt das aktuelle Item zurück
' */
Public Property Get current() As Variant
    getCurrent current
End Property

'/**
' * Gibt den Value aus. Bei den meisten Listen entspricht das dem current.
' */
Public Property Get value() As Variant
    getCurrent value, True
End Property

'/**
' * Key oder pos des aktuellen Item.
' * Bei Dictionaries ist es der Key, beim Rest der Index
' */
Public Property Get key() As Variant
    Select Case listType
        Case itDictionary, itProperties, itDaoFields, itExcelSheets, itExcelWoorkbook:
            If LBound(myKeys) <= Me.index And Me.index <= UBound(myKeys) Then
                key = myKeys(Me.index)        'Bei Dictioniraies, Fields, Properties, den KEY/Namen ausgeben
            Else
                key = Empty
            End If
        Case Else:
            key = Me.index              'Ansonsten den Index
    End Select
End Property

'/**
' * Index des aktuellen Item. Auch bei Dictionaries wird der index ausgegeben, nicht der Key
' * Der Index kann je nach listType unterschiedlich beginnen. Bei Arrays beginnt er bei lbound(map), bei Collections mit 1 und beim Rest mit 0
' */
Public Property Get index() As Long
    index = pos + delta
End Property

'/**
' * Unabhängig von der Indexierung der Liste (lBound() bei Array, starten mit 1 bei Collection)
' * Die Absolute Position in der Liste, beginnend mit 0
' * Bei einer leeren Liste wird -1 ausgegeben
' */
Public Property Get absolutePosition() As Long
    absolutePosition = pos
End Property

'/**
' * End Of File
' */
Public Property Get EOF() As Boolean
    EOF = IIf(isEmpty, True, pos >= cnt)
End Property

'/**
' * Begin Of File
' */
Public Property Get BOF() As Boolean
    BOF = IIf(isEmpty, True, pos < 0)
End Property

'/**
' * Gibt die Anzhal Items der Liste zurück
' */
Public Property Get count() As Long
    If isEmpty Then
        count = 0
    Else
        Select Case listType
            Case itArray:
                count = (UBound(map) + 1) - LBound(map)
            Case itDaoRecordset:
                Dim bookmark As Variant:    bookmark = map.bookmark
                map.MoveLast
                count = map.RecordCount
                map.bookmark = bookmark
            Case Else:
                count = map.count
        End Select
    End If
End Property

'/**
' * Erstellt ein Clone des Iterators. Die Position wird nicht mitgeklont
' */
Public Property Get clone() As Iterator
    Set clone = Iterator.instance(map, Me.params)
End Property

'/**
' * Letzter Index. UBOUND() eines Array.
' */
Public Property Get lastIndex() As Long
    lastIndex = Me.count - 1 + delta
End Property

'/**
' * Erster Index. LBOUND() eines Arrays
' */
Public Property Get firstIndex() As Long
    firstIndex = delta
End Property

'/**
' * Prüft ob die Liste leer ist
' */
Public Property Get isEmpty() As Boolean
    Select Case listType
        Case itArray:
            isEmpty = IsMissing(map)
        Case itDaoRecordset:
            isEmpty = (map.RecordCount = 0)
        Case Else:
            isEmpty = (map.count = 0)
    End Select
End Property

'/**
' * Information, ob der Iterator initialisiert ist
' */
Public Property Get isInitialized() As Boolean
    isInitialized = flagIsInitialized And Not isNothing(map)
End Property

'/**
' * Die Parameter als Enum-Set
' * @param  itParam
' */
Public Property Get params() As itParams
    params = myParams
End Property
Public Property Let params(ByVal iParams As itParams)
    If iParams < 0 Then
        'Paramter abziehen
        If Not isInitialized Then myParams = itDefault
        Dim pp As Variant: pp = bitArray(Abs(iParams), baValue, True)
        Dim i As Integer: For i = 0 To UBound(pp)
            If andB(itDefault, pp(i)) Then myParams = myParams - pp(i)
        Next i
    Else
        'Parameter übernhemen
        myParams = iParams
    End If
End Property

'/**
' * Die Keys als Array
' */
Public Property Get keys() As Variant()
    keys = myKeys
End Property

'/**
' * Die Collection der Items, die fürs Iterieren verwendet wird
' * @return Collection
'*/
Public Property Get forEachCol() As Collection
    ref forEachCol, forEachCollection
End Property

' --  DIE SETTINGS ALS EINZELPROPERTIES ---
' Die Settings können über diese Properties nach dem Initialisieren einzeln gesetzt werden

'itNothingAsEmptyList = 2 ^ 0
'Leerer String, Nothing, Empty, Null wird als leere Liste akzeptiert und wirft kein Fehler
'Da dieses Attribut beim initialize() verwendet wird, macht es keinen Sinn dieses Flag später zu ändern
Public Property Get paramNothingAsEmptyList() As Boolean
    paramNothingAsEmptyList = andB(myParams, itNothingAsEmptyList)
End Property

'itListNextNoParamsAsToNext = 2 ^ 1
'Wenn bei listNext keine Parameter angeben werden, einfach eins vorrücken.
Public Property Get paramListNextNoParamsAsToNext() As Boolean
    paramListNextNoParamsAsToNext = andB(myParams, itListNextNoParamsAsToNext)
End Property
Public Property Let paramListNextNoParamsAsToNext(ByVal iFlag As Boolean)
    setParam iFlag, itListNextNoParamsAsToNext
End Property

'itErrorAtEmptyList = 2 ^ 2
'Fehler generieren, wenn die iListe leer ist
Public Property Get paramErrorAtEmptyList() As Boolean
    paramErrorAtEmptyList = andB(myParams, itErrorAtEmptyList)
End Property
Public Property Let paramErrorAtEmptyList(ByVal iFlag As Boolean)
    setParam iFlag, itErrorAtEmptyList
End Property

'itDaoValue = 2 ^ 3
'Field-Value anstelle von Field ausgeben
Public Property Get paramDaoValue() As Boolean
    paramDaoValue = andB(myParams, itDaoValue)
End Property
Public Property Let paramDaoValue(ByVal iFlag As Boolean)
    setParam iFlag, itDaoValue
End Property

'itIndexInsteadKey = 2 ^ 4
'Gibt bei den toX() Funktionen den Index anstelle des Keys zurück
Public Property Get paramIndexInsteadKey() As Boolean
    paramIndexInsteadKey = andB(myParams, itIndexInsteadKey)
End Property
Public Property Let paramIndexInsteadKey(ByVal iFlag As Boolean)
    setParam iFlag, itIndexInsteadKey
End Property

'Eine eindeutige Id der Instanz
Public Property Get uid(Optional iNew As Boolean) As Variant
    Static Counter  As Variant
    If iNew Or pUid = 0 Then
        Counter = Counter + 1
        pUid = Counter
    End If
    uid = CDec(CDbl(Now) * 10 ^ 10 & pUid)
End Property
'-------------------------------------------------------------------------------
' -- Private Properties
'-------------------------------------------------------------------------------
Private Property Get listTypes() As Object
    Static lt As Object
    If lt Is Nothing Then
        Set lt = CreateObject("scripting.Dictionary")
        lt.add "Dictionary", itDictionary
        lt.add "Collection", itCollection
        lt.add "IMatchCollection2", itMatchCollection
        lt.add "IMatch2", itMatch
        lt.add "QueryDef", itQueryDef
        lt.add "TableDef", itTableDef
        lt.add "Recordset2", itDaoRecordset
        lt.add "Fields", itDaoFields
        lt.add "Field2", itDaoField
        lt.add "Properties", itProperties
        lt.add "Sheets", itExcelSheets
        lt.add "Workbook", itExcelWoorkbook
        lt.add "Folder", itFSOFolder
        lt.add "Folders", itFSOFolders
        lt.add "String", itSqlString
        lt.add "AllObjects", itIndex0List
        lt.add "References", itIndex1List
        lt.add "QueryDefs", itIndex0List
        lt.add "TableDefs", itIndex0List
        lt.add "VBComponents", itIndex1List
        lt.add "OTHER", itNoList
    End If
    Set listTypes = lt
End Property

'-------------------------------------------------------------------------------
' -- Private Libraries
'-------------------------------------------------------------------------------

'/**
' * Version 1.0.1
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/isnothing
' * Prüft, ob eine Variable Null, Empty, Nothing, Leerstring, leerer Array etc ist
' *
' *     boolean = isNothing(object)
' *     boolean = isNothing(vaule)
' *
' * @param  Variant     Variable die geprüft werden soll
' * @return Boolean
' */
Public Function isNothing(ByRef iValue As Variant) As Boolean
    isNothing = True
    Select Case TypeName(iValue)
        Case "Nothing", "Empty", "Null":    Exit Function
        Case "Collection", "Dictionary":    If iValue.count = 0 Then Exit Function
        Case "String":                      If Len(Trim(iValue)) = 0 Then Exit Function
        Case "Iterator":                    If Not iValue.isInitialized Then Exit Function
        '//TODO: weitere Spezialfälle
        Case Else:
            If IsArray(iValue) And IsMissing(iValue) Then Exit Function
    End Select
    isNothing = False
End Function

'/**
' * @param  Number
' * @param  incType     Type der Encrementation. Default ist i++
' * @retrun Number
'*/
Private Function inc(ByRef i As Variant, Optional ByVal iIncType As incType = itPreIncrement) As Variant
    Select Case iIncType
        Case itPreIncrement:    i = i + 1:  inc = i     '++i
        Case itPostIncrement:   inc = i:    i = i + 1   'i++
        Case itPreDecrement:    i = i - 1:  inc = i     '--i
        Case itPostDecrement:   inc = i:    i = i - 1   'i--
    End Select
End Function

'/**
' * Inteligentere Umsetzung des VBA-Befehls CStr
' * Die Funktion erkennt auch Objekte mit dem Interface IFormattable
' * Zudem sind diverse weitere Objekte/Typen abgedeckt
' * @param  Variant     Value der zu einem String geparst werden soll
' * @param  csfParams   Paramter um das Verhalten von CStrF zu steuern
' * @retrun String
' */
Private Function cStrF( _
        ByRef iValue As Variant, _
        Optional ByVal iParams As itToStringParams = itListAsJson + itNullAsEmpty, _
        Optional ByVal iFormat As String, _
        Optional ByRef FormatProvider As Object, _
        Optional ByVal iDelemiter As String = ", " _
) As String
    Dim values() As String
    Dim i As Long
On Error Resume Next
    'Standard CStr
    cStrF = CStr(iValue)
    If Err.Number = 0 Then Exit Function
    'toString Methode
    Err.clear
    cStrF = iValue.toString
    If Err.Number = 0 Then Exit Function
#If IFormattable_exists Then
    'IFormattable
    Err.clear
    Dim tfb As IFormattable: Set tfb = iValue
    cStrF = tfb.toString(iFormat, FormatProvider)
    If Err.Number = 0 Then Exit Function
#End If
#If lib_json_exists Then
    'Array, Dictionary, Collection -> Json
    If andB(iParams, itListAsJson) Then
        Err.clear
        cStrF = obj2json(iValue)
        If Err.Number = 0 Then Exit Function
    End If
#End If
    'Array, Dictionary
    Err.clear
    If TypeName(iValue) = "Dictionary" Then iValue = iValue.items   'Die Items als Array aus dem Dictionary extrahieren
    If IsArray(iValue) Then
        'Bei einem Array alle items parsen und zusammenhängen
        ReDim values(LBound(iValue) To UBound(iValue))
        For i = LBound(iValue) To UBound(iValue)
            values(i) = cStrF(iValue(i), iParams + IIf(Not andB(iParams, csfIsSubItem), csfIsSubItem, 0), iDelemiter)
        Next i
        cStrF = Join(values, iDelemiter)
        If andB(iParams, csfIsSubItem) Then cStrF = "(" & cStrF & ")"
        If Err.Number = 0 Then Exit Function
    End If
    'Nach speziellen Typen
    Err.clear
On Error GoTo Err_Handler
    Select Case TypeName(iValue)
        'Null, Nothing
        Case "Null", "Nothing":    cStrF = IIf(andB(iParams, csfNullAsEmpty), Empty, notCastable(iValue, iParams))
        'RegExp -> Gibt den pattern inkl. Paramters zurück
        'http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#beispiele_mit_patterns_inkl_den_parametern
        Case "IRegExp2":
            cStrF = iValue.pattern
            If Not andB(iParams, csfRegExpOnlyPattern) Then cStrF = "/" & cStrF & "/" & IIf(iValue.IgnoreCase, "i", "") & IIf(iValue.Global, "g", "") & IIf(iValue.Multiline, "m", "")
        'MatchCollection
        Case "IMatchCollection2":
            If iValue.count = 0 Then Exit Function
            ReDim values(iValue.count - 1)
            For i = 0 To iValue.count - 1
                values(i) = iValue(i).value
            Next i
            cStrF = cStrF(values, iParams, iDelemiter)
        'Nur den Typenname ausgeben
        Case Else:          cStrF = notCastable(iValue, iParams)
    End Select
    
Exit_Handler:
    Exit Function
Err_Handler:
    cStrF = notCastable(iValue, iParams)
    Resume Exit_Handler
End Function

'/**
' * Handel den Fall, dass ein Wert nicht in String geparst werden kann
' * @param  Variant     Value der zu einem String geparst werden soll
' * @param  csfParams   Paramter um das Verhalten von CStrF zu steuern
' * @retrun String
' */
Private Function notCastable(ByRef iValue As Variant, ByVal iParams As csfParams) As String
    'Falls Fehler gewünscht werden, diese ausgeben
    'If andB(iparams, csfNotCastableToError) Then Err.Raise C_CSTRF_PARSE_ERROR, , "cStrF: Type " & TypeName(iValue) & " is not castable"
    notCastable = "#" & TypeName(iValue)
End Function

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