VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Hashtable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'This Hashtable class provides a basic hash table.
'7 Sept 2004
'
' Usage:
'  Set X = New Hashtable
'  X.Define key1, value1
'  Y = X.Retrieve(key1)
'  X.PrintAll
'  X.Remove(key1)
'  X.DeleteAll
'
' Dependencies: None.


Private Type HashType
    hKey As String
    hValue As String
End Type

Dim MyHash() As HashType


Private Sub Class_Initialize()
    '7 Sept 2004 CGL.
    'Object constructer sets initial size to zero.
    ReDim MyHash(0 To 0)
End Sub


Private Sub Class_Terminate()
    '7 Sept 2004 CGL.
    'Object destructer doesn't have to do anything.
End Sub


Property Get Size() As Long
    '7 Sept 2004 CGL.
    'Return the number of entries in the hash table.
    Size = UBound(MyHash)
End Property


Public Function Define(ByVal sKey As String, ByVal sValue As String)
    '7 Sept 2004 CGL.
    'Add an entry to the hash table.  Delete the old one, if it existed.
    Dim newsize As Long
    Remove (sKey)
    newsize = Size + 1
    ReDim Preserve MyHash(0 To newsize)
    MyHash(newsize).hKey = sKey
    MyHash(newsize).hValue = sValue
End Function


Public Function Retrieve(ByVal sKey As String) As String
    '7 Sept 2004 CGL.
    'Retrieve an entry from the hash table.
    'If there are multiple entries with the same key, return the first one.
    Dim i As Long
    Retrieve = ""
    For i = 1 To Size
        If (MyHash(i).hKey = sKey) Then
            Retrieve = MyHash(i).hValue
            Exit Function
        End If
    Next i
End Function


Public Sub Remove(ByVal sKey As String)
    '7 Sept 2004 CGL.
    'Remove an entry from the hash table.
    'If there are multiple entries with the same key, remove all.
    Dim i As Long
    Dim newsize As Long
    'Loop through the hash table.
    For i = Size To 1 Step -1
        'If a key matches, move it to the end and chop it off.
        If (MyHash(i).hKey = sKey) Then
            If (i < Size) Then Swap i, Size
            newsize = Size - 1
            ReDim Preserve MyHash(0 To newsize)
        End If
    Next i
End Sub


Private Sub Swap(ByVal i As Long, ByVal j As Long)
    '7 Sept 2004 CGL.
    'Swap locations for hash entries i and j.
    Dim temp As HashType
    If (i > Size Or j > Size) Then Exit Sub
    temp = MyHash(i)
    MyHash(i) = MyHash(j)
    MyHash(j) = temp
End Sub


Public Sub DeleteAll()
    '7 Sept 2004 CGL.
    ReDim MyHash(0 To 0)
End Sub


Public Function PrintAll() As String
    '7 Sept 2004 CGL.
    Dim i As Long
    Dim txt As String
    For i = 1 To Size
        txt = txt & "[" & MyHash(i).hKey & ", " & MyHash(i).hValue & "]"
        txt = txt & vbCrLf
    Next i
    PrintAll = txt
End Function


Public Sub TestThisClass()
    '7 Sept 2004 CGL.
    'Test only.  Never used.
    Define "key1", "value1"
    Define "key2", "value2"
    Define "key3", "value3"
    Define "key4", "junk"
    Define "key4", "value4"
    MsgBox PrintAll
    MsgBox "Now remove key2 " & Retrieve("key2")
    Remove "key2"
    MsgBox PrintAll
End Sub

