Class NewDictionary

    Private oDic 'Will hold the hidden inner dictionary



    '****** Class LifeCycle ****** 

    Sub Class_Initialize 'Will fire automatically when create a new instance

        Set oDic = CreateObject("Scripting.Dictionary")

    End Sub



    Sub Class_Terminate 'Will fire automatically when an instance is destroyed

        Set oDic = Nothing

    End Sub



    '****** Basic properties ****** 

    'All these properties are read-only

    'This is why they only contain a Get block



    Public Property Get Count 'Returns the number of items in our dictionary

        Count = oDic.Count 'The answer is the number of items in the inner dictionary

    End Property



    Public Property Get Keys 'Returns the dictionary keys (array)

        Keys = oDic.Keys

    End Property



    Public Property Get Items 'Returns the dictionary items (array)

        Items = oDic.Items

    End Property



    Public Property Get Exists(Key) 'Returns a True/False if the Key exists

        Exists = oDic.Exists(Key)

    End Property



    '****** Improved Methods ****** 



    Public Sub Remove(Key) 'Removes the key from the dictionary (it it existed)

        If oDic.Exists(Key) Then oDic.Remove(Key)

    End Sub



    Public Sub Add(Key, Value) 'Adds a new value to the dictionary. Overwrites existing values

        Call Me.Remove(Key)

        oDic.Add Key, Value

    End Sub





    Public Function Item(Key) 'Returns an item, either by a key or an index

        Dim arrKeys 'Will hold the inner dictionary keys

        Dim sRealKey 'The actual key which holds the needed value



        arrKeys = oDic.Keys



        If IsNumeric(Key) Then

            sRealKey = arrKeys(Key) 'We have to translate the number to the corresponding key

        Else

            sRealKey = Key 'We can use the key as it is

        End If



        'If the relevant item is an object, we'll have to use the Set keyword to retun it

        If IsObject(oDic.Item(sRealKey)) Then

            Set Item = oDic.Item(sRealKey)

        Else

            Item = oDic.Item(sRealKey)

        End If

        

    End Function



    '****** New Methods ****** 



    Public Function Key(iIndex) 'Returns the key at a given index

        Dim arrKeys

    

        If iIndex > Me.Count -1 Then Exit Function 'There is no such key

    

        arrKeys = Me.Keys

        Key = arrKeys(iIndex)    

    End Function

    

    Public Function Clone 'Returns a copy of the dictionary

        Dim i

        Dim oResult

    

        Set oResult = New NewDictionary

    

        For i = 0 to Me.Keys - 1

            oResult.Add Me.Key(i), Me.Item(i)

        Next

    

        Set Clone = oResult

    End Function

    

    Public Sub Merge(oOutsideDictionary) 'Merges the dictionary with another one

        Dim i

    

        For i = 0 to oOutsideDictionary.Count - 1

            'Add the value, but don't overwrite

            If Not Me.Exists(oOutsideDictionary.Key(i)) Then _

                Me.Add oOutsideDictionary.Key(i), oOutsideDictionary.Item(i)

        Next

    End Sub



    Sub Export(sFileName) 'Exports the dictionary to a text file

        Dim i

        Dim oFSO

        Dim oFile

        Dim sData

    

       On Error Resume Next 'Protects from object items

    

        'First, create a string holding the dictionary data

        For i = 0 to Me.Count - 1

            sData = sData & "|" & Me.Key(i) & ">" & Me.Item(i)

        Next

    

        sData = Mid(sData,2) 'Get rid of the first, unneeded '|'

    

        'Now, write the string to an external file

        Set oFSO = CreateObject("Scripting.FileSystemObject")

        Set oFile = oFSO.CreateTextFile(sFileName, True)

    

        Call oFile.Write(sData)

    

        oFile.Close

    

        Set oFile = Nothing

        Set oFSO = Nothing

    

        On Error Goto 0

    End Sub

    

    Sub Import(sFileName) 'Builds the dictionary from an external file

        Dim i

        Dim oFSO

        Dim oFile

        Dim sData

        Dim arrData, arrSingleField

    

        On Error Resume Next 'Protects from wrong file names

    

        Set oFSO = CreateObject("Scripting.FileSystemObject")

        Set oFile = oFSO.OpenTextFile(sFileName, 1, True)

    

        sData = oFile.ReadAll

    

        oFile.Close

    

        Set oFile = Nothing

        Set oFSO = Nothing

    

        'Split the data string to its separate key>item pairs

        arrData = Split(sData, "|")

    

        For i = 0 to uBound(arrData)

            'Split each pair

            arrSingleField = Split(arrData(i), ">")



            'Add the value to the dictionary

            Me.Add arrSingleField(0), arrSingleField(1)

        Next

    

        On Error Goto 0

    End Sub



End Class