Page 1 sur 1
hashTable
Publié:
30 Jan 2005 à 12:48par oguruma
- Code : Tout sélectionner
Private Class HashtableNode
previous As HashtableNode
next As HashtableNode
value As Variant
key As Variant
Public Sub setPrevious(inPrevious As HashtableNode)
Set Me.previous = inPrevious
End Sub
Public Function getPrevious() As HashtableNode
Set Me.getPrevious = Me.previous
End Function
Public Sub setNext(inNext As HashtableNode)
Set Me.next = inNext
End Sub
Public Function getNext() As HashtableNode
Set Me.getNext = Me.next
End Function
Public Sub setKey(inKey As Variant)
If Isobject(inKey) Then
Set Me.key = inKey
Else
Me.key = inKey
End If
End Sub
Public Function getKey() As Variant
If Isobject(Me.key) Then
Set Me.getKey = Me.key
Else
Me.getKey = Me.key
End If
End Function
Public Function setValue(inValue As Variant)
If Isobject(inValue) Then
Set Me.value = inValue
Else
Me.value = inValue
End If
End Function
Public Function getValue() As Variant
If Isobject(Me.value) Then
Set Me.getValue = Me.value
Else
Me.getValue = Me.value
End If
End Function
End Class
Public Class Hashtable
' A bad imitation of java.util.Hashtable...
' This is not a real Hashtable, as a real one uses hash values for each
' object passed to the table, for fast, indexed, access.
' The keys are NOT sorted.
' In LotusScript, there is no (?) way to get a hash of an object in a
' reasonable amount of time.
' This implementation may be slow on great number of key - value pairs,
' as it uses Vectors internally.
' A real Hashtable uses unique keys, but this class can handle multiple values with the same key,
' if the setMultipleKeys is set to true.
multipleKeys As Integer
elementCount As Long
last As HashtableNode
first As HashtableNode
cachedNode As HashtableNode
Public Sub setMultipleKeys(multiple As Integer)
' Set to true to get a Hashtable that can handle multiple values with the same key.
Me.multipleKeys = multiple
End Sub
Public Function isMultipleKeysEnabled() As Integer
' Returns true if the Hashtable is enabled to handle multiple values with the same key
isMultipleKeysEnabled = multipleKeys
End Function
Public Function size() As Long
' Returns the current number of keys in the Hashtable
Me.size = Me.elementCount
End Function
Public Function isEmpty() As Integer
' Returns true if the number of the keys in the Hashtable is 0 (zero)
Me.isEmpty = (Me.size = 0)
End Function
Public Function keys() As Enumeration
' Returns an Enumeration of all key elements in the Hashtable
Set Me.keys = New HashtableEnumeration(Me.first, True)
End Function
Public Function elements() As Enumeration
' Returns an Enumeration of all value elements in the Hashtable
Set Me.elements = New HashtableEnumeration(Me.first, False)
End Function
Private Function equals(element1 As Variant, element2 As Variant) As Variant
equals = False
If Isobject(element1) And Not Isobject(element2) Then Exit Function
If Isobject(element1) Then
If element1 Is element2 Then equals = True
Else
If element1 = element2 Then equals = True
End If
End Function
Public Function contains(element As Variant) As Variant
' Returns true if the Hashtable contains the specified value
Me.contains = False
Dim node As HashtableNode
Set node = first
Do While Not node Is Nothing
If Me.equals(element, node.getValue()) Then
Me.contains = True
Exit Do
End If
Set node = node.getNext()
Loop
If Not cachedNode Is Nothing Then Set cachedNode = node
End Function
Public Function containsKey(key As Variant) As Variant
' Returns true if the Hashtable contains the specified key
Me.containsKey = False
Dim node As HashtableNode
Set node = first
Do While Not node Is Nothing
If Me.equals(key, node.getKey()) Then
Me.containsKey = True
Exit Do
End If
Set node = node.getNext()
Loop
If Not cachedNode Is Nothing Then Set cachedNode = node
End Function
Public Function get(key As Variant) As Variant
' Returns the value that corresponds to the specified key
' If the Hashtable has been enabled for values with the same keys, this function only returns the first value found.
Set Me.get = Nothing
If Not cachedNode Is Nothing Then
If Isobject(key) And Isobject(cachedNode.getKey()) Then
If key Is cachedNode.getKey() Then
Set Me.get = cachedNode.getValue()
Exit Function
End If
Elseif (Not Isobject(key)) And (Not Isobject(cachedNode.getKey())) Then
If key = cachedNode.getKey() Then
Me.get = cachedNode.getValue()
Exit Function
End If
End If
End If
Dim node As HashtableNode
Set node = first
Do While Not node Is Nothing
If Me.equals(key, node.getkey()) Then
If Isobject(node.getValue()) Then
Set Me.get = node.getValue()
Else
Me.get = node.getValue()
End If
Set Me.cachedNode = node
Exit Function
End If
Set node = node.getNext()
Loop
End Function
Public Function put(key As Variant, value As Variant) As Variant
' Sets a key - value pair. If the supplied already exists in the Hashtable,
' this function returns the value prior to the new one or Nothing,
' if the specified key was not found in the Hashtable.
' If not setMultipleKeys are enabled, this function replaces the value
' of the specified key (if found).
Set Me.put = Nothing
Dim node As New HashtableNode()
Call node.setKey(key)
Call node.setValue(value)
If last Is Nothing Then ' Empty hashtable
Call node.setPrevious(Nothing)
Call node.setNext(Nothing)
Set last = node
Set first = node
Else
Call last.setNext(node)
Call node.setPrevious(last)
Call node.setNext(Nothing)
End If
Set last = node
Set cachedNode = node
elementCount = elementCount + 1
End Function
Public Function remove(key As Variant) As Variant
' Removes the specified key with its corresponding value,
' and returns the value removed or Nothing, if the key was not found.
Set Me.remove = Nothing
Dim node As HashtableNode
Set node = first
Do While Not node Is Nothing
If Me.equals(key, node.getkey()) Then
If Isobject(node.getValue()) Then
Set Me.remove = node.getValue()
Else
Me.remove = node.getValue()
End If
Dim nextNode As HashtableNode
Set nextNode = node.getNext()
Dim previousNode As HashTableNode
Set previousNode = node.getPrevious()
If Not previousNode Is Nothing Then
If Not nextNode Is Nothing Then
Call previousNode.setNext(nextNode)
Call nextNode.setPrevious(previousNode)
End If
Else
If Not nextNode Is Nothing Then
Call nextNode.setPrevious(Nothing)
Set Me.first = nextNode
Else
Call previousNode.setNext(Nothing)
Set Me.last = previousNode
End If
End If
Set node = Nothing
elementCount = elementCount - 1
Exit Function
End If
Set node = node.getNext()
Loop
End Function
Public Sub clear()
' Removes all keys and values in the Hashtable
Dim node As HashtableNode
Dim prevNode As HashtableNode
Set node = first
Do While Not node Is Nothing
Call node.setKey(Nothing)
Call node.setValue(Nothing)
Call node.setPrevious(Nothing)
Set prevNode = node
Set node = prevNode.getNext()
Call prevNode.setNext(Nothing)
Set prevNode = Nothing
Loop
Me.elementCount = 0
End Sub
Public Function toString() As String
' Returns a String representation of this Hashtable.
Dim s As String
s = "{"
Dim node As HashtableNode
Set node = first
Do While Not node Is Nothing
s = s & Cstr(node.getKey()) & "=" & Cstr(node.getValue())
If Not node.getNext() Is Nothing Then s = s & ", "
Set node = node.getNext()
Loop
s = s & "}"
toString = s
End Function
Public Function toArray() As Variant
' Returns a two dimensional array of the key-value pairs
Dim a As Variant
Redim a(elementCount - 1, 1)
Dim i As Long
Dim node As HashtableNode
Set node = first
Do While Not node Is Nothing
If Isobject(node.getKey()) Then
Set a(i, 0) = node.getKey()
Else
a(i, 0) = node.getKey()
End If
If Isobject(node.getValue()) Then
Set a(i, 1) = node.getValue()
Else
a(i, 1) = node.getValue()
End If
i = i + 1
Set node = node.getNext()
Loop
Me.toArray = a
End Function
End Class
Public Class HashtableEnumeration As Enumeration
isKey As Integer
node As HashtableNode
Public Sub new(inHashtableNode As HashtableNode, inIsKey As Integer)
Set Me.node = inHashtableNode
Me.isKey = inIsKey
End Sub
Public Function hasMoreElements() As Variant
Me.hasMoreElements = False
If node Is Nothing Then Exit Function
Me.hasMoreElements = True
End Function
Public Function nextElement() As Variant
If Not Me.hasMoreElements() Then Error 2000, "No more elements"
If Me.isKey Then
If Isobject(node.getKey()) Then
Set Me.nextElement = node.getKey()
Else
Me.nextElement = node.getKey()
End If
Else
If Isobject(node.getValue()) Then
Set Me.nextElement = node.getValue()
Else
Me.nextElement = node.getValue()
End If
End If
Set Me.node = node.getNext()
End Function
End Class