Thursday, 17 January 2013

Function To Create DictionaryObject using VB Script

Function To Create DictionaryObject using VB Script

Class DictionaryObj
    'The actual dictionary
    Private oDict
    'Private variable for storing value of AccessUsingIndex property
    Private mAccessUsingIndex
    'Now we need add all functions that the Dictionary already supports
    Public Property Get HashVal(Text)
        HashVal = oDict.HashVal(Text)
    End Property
    'Method to add a Key Value Pair
    Public Sub Add(ByVal Key, ByVal Item)
        oDict.Add Key, Item
    End Sub
    'Return the array of keys
    Public Function Keys()
        Keys = oDict.Keys
    End Function
    'Property to change key
    Public Property Let Key(oldKey, newKey)
        oDict.Key(oldKey) = newKey
    End Property
    'Returns array of items
    Public Function Items()
        Items = oDict.Items
    End Function
    'Check if certain key exists or not
    Public Function Exists(Key)
        Exists = oDict.Exists(Key)
    End Function
    'Remove All keys
    Public Sub RemoveAll()
        oDict.RemoveAll
    End Sub
    'Remove a specified key
    Public Sub Remove (Key)
        oDict.Remove GetKey(Key)
    End Sub
    'Get count of items in dictionary
    Public Property Get Count()
        Count = oDict.Count
    End Property
    'Get Property for CompareMode
    Public Property Get CompareMode()
        CompareMode = oDict.CompareMode
    End Property
    'Let Property for CompareMode
    Public Property Let CompareMode(newMode)
        oDict.CompareMode = newMode
    End Property
    'AccessUsingIndex is a flag which can be set to True/False If Set to True then Numeric Keys will be translated to index
    'values and there corresponding keys will be used.In case the numeric value is an existing key in the dictionary then it would not be translated
    Public Property Get AccessUsingIndex()
        AccessUsingIndex = mAccessUsingIndex
    End Property
    'Let property for AccessUsingIndex
    Public Property Let AccessUsingIndex(newValue)
        If newValue = True Or newValue = False Then
            mAccessUsingIndex = newValue
        Else
            'If anything other then True/False raise an error
            Err.Raise vbObjectError + 1, "DictionaryEx AccessUsingIndex can only be set true/false."
        End If
    End Property
    'Returns the actual dictionary object. This allows to do pass dictionary
    'to function which might support the actual dictionarty object
    Public Function Object()
        Set Object = oDict
    End Function
    'Function to translate keys from Index to actual key
    Private Function GetKey(Key)
        'Return actual key in case we are not
        'able to translate index to key
        GetKey = Key
        If Me.AccessUsingIndex Then
            'If the key already exist we do not want to change
            'anything even if it is a numeric value
            If Not oDict.Exists(Key) And IsNumeric(Key) Then
                keyIndex = CInt(Key)
                'Check if index is within range
                If keyIndex < Me.Count Then
                    Dim aKeys
                    aKeys = Me.Keys
                    'Translate from Index to Key
                    Key = aKeys(keyIndex)
                    Exit Function
                End If
            End If
        End If
    End Function
    'Item is the Default property for dictionary. So we need to use default keyword with Property Get
    'Default keyword can be used with a only one Function or Get Property
    Public Default Property Get Item(Key)
        'If a object is stored for the Key then we need to use Set to return the object
        If IsObject(oDict.Item(GetKey(Key))) Then
            Set Item = oDict.Item(GetKey(Key))
        Else
            Item = oDict.Item(GetKey(Key))
        End If
    End Property
    'Let property Item
    Public Property Let Item(Key, Value)
        'Check of the value is an object
        If IsObject(Value) Then
            'The value is an object, use the Set method
            Set oDict(GetKey(Key)) = Value
        Else
            'The value is not an object assign it
            oDict(GetKey(Key)) = Value
        End If
    End Property
    'Property Set Item
    Public Property Set Item(Key, Value)
        Set oDict(GetKey(Key)) = Value
    End Property
    'AddFromDictionary takes an actual dictionary object and add all keys from it
    Public Sub AddFromDictionary(oldDict)
        aKeys = oldDict.Keys
        Me.AccessUsingIndex = False
        For Each sKey In aKeys
            oDict(sKey) = oldDict(sKey)
        Next
    End Sub
    'LoadFromDictionary function removes all keys and then add the keys from dictionary. It is
    'equivalent of creating a clone from a existing dictionarty object
    Public Sub LoadFromDictionary(oldDict)
        oDict.RemoveAll
        Me.AddFromDictionary oldDict
    End Sub
    'Function to read dictionary key/value from file
    Public Sub AddFromFile(FileName, Delimiter)
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set oFile = Fso.OpenTextFile (FileName)
        'Read the file line by line
        While Not oFile.AtEndOfStream
            sLine = oFile.ReadLine
            KeyValue = Split(sLine, Delimiter)
            oDict(KeyValue(0)) = KeyValue(1)
        Wend
        Set oFile = Nothing
        Set FSO = Nothing
    End Sub
    'Function to remove all keys and then load it from
    'file
    Public Sub LoadFromFile(FileName, Delimiter)
        oDict.RemoveAll
        Me.AddFromFile FileName, Delimiter
    End Sub
    'Export the dictionarty to a file and use Delimiter
    'to seperate Key and Value pairs
    Public Sub ExportToFile(FileName, Delimeter)
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set oFile = FSO.CreateTextFile(FileName, True)
        Dim aKeys
        aKeys = oDict.Keys
        'Write the key value pairs line by line
        For Each sKey In aKeys
            oFile.WriteLine sKey & Delimeter & oDict(sKey)
        Next
        'Close the file
        oFile.Close
        Set oFile = Nothing
        Set FSO = Nothing
    End Sub
    'Intialize event gets executed whenever a object is created
    Sub Class_Initialize()
        Set oDict = CreateObject("Scripting.Dictionary")
        Me.AccessUsingIndex = False
    End Sub
    'Executed when the object is destroyed
    Sub Class_Terminate()
        'Remove all the keys
        oDict.RemoveAll
        'Destroy the dictionary
        Set oDict = Nothing
    End Sub
End Class
Public Function CreateDictionary()
    Set CreateDictionary = New DictionaryObj
End Function

No comments:

Post a Comment