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
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