Sub Remove(Key As String)
Dim ndx As Long, HCode As Long, LastNdx As Long
ndx = GetSlotIndex(Key, False, HCode, LastNdx)
If ndx = 0 Then Err.Raise 5
If LastNdx Then
slotTable(LastNdx).nextItem = slotTable(ndx).nextItem
ElseIf slotTable(ndx).nextItem Then
hashTbl(HCode) = slotTable(ndx).nextItem
Else
hashTbl(HCode) = 0
End If
slotTable(ndx).nextItem = FreeNdx
FreeNdx = ndx
mCount = mCount - 1
End Sub
Sub RemoveAll()
SetSize mHashSize, mListSize, mChunkSize
End Sub
Property Get Count() As Long
Count = mCount
End Property
Property Get Keys() As Variant()
Dim i As Long, ndx As Long
Dim N As Long
ReDim res(0 To mCount - 1) As Variant
For i = 0 To mHashSize - 1
ndx = hashTbl(i)
Do While ndx
res(N) = slotTable(ndx).Key
N = N + 1
ndx = slotTable(ndx).nextItem
Loop
Next
Keys = res()
End Property
Property Get Values() As Variant()
Dim i As Long, ndx As Long
Dim N As Long
ReDim res(0 To mCount - 1) As Variant
For i = 0 To mHashSize - 1
ndx = hashTbl(i)
Do While ndx
res(N) = slotTable(ndx).Value
N = N + 1
ndx = slotTable(ndx).nextItem
Loop
Next
Values = res()
End Property
Private Sub Class_Initialize()
SetSize DEFAULT_HASHSIZE, DEFAULT_LISTSIZE, DEFAULT_CHUNKSIZE
End Sub
Private Sub ExpandSlotTable(ByVal numEls As Long)
Dim newFreeNdx As Long, i As Long
newFreeNdx = UBound(slotTable) + 1
ReDim Preserve slotTable(0 To UBound(slotTable) + numEls) As SlotType
For i = newFreeNdx To UBound(slotTable)
slotTable(i).nextItem = i + 1
Next
slotTable(UBound(slotTable)).nextItem = FreeNdx
FreeNdx = newFreeNdx
End Sub
Private Function HashCode(Key As String) As Long
Dim lastEl As Long, i As Long
lastEl = (Len(Key) - 1) \ 3
ReDim codes(lastEl) As Long
For i = 1 To Len(Key)
codes((i - 1) \ 3) = CLng(codes((i - 1) \ 3)) * 256 + Asc(Mid(Key, i, 1))
Next
For i = 0 To lastEl
HashCode = HashCode Xor codes(i)
Next
End Function
Private Function GetSlotIndex(ByVal Key As String, Optional Create As Boolean, Optional HCode As Long, Optional LastNdx As Long) As Long
Dim ndx As Long
If Len(Key) = 0 Then Err.Raise 1001, , "Invalid key"
If mIgnoreCase Then Key = UCase$(Key)
HCode = HashCode(Key) Mod mHashSize
ndx = hashTbl(HCode)
Do While ndx
If slotTable(ndx).Key = Key Then Exit Do
LastNdx = ndx
ndx = slotTable(ndx).nextItem
Loop
If ndx = 0 And Create Then
ndx = GetFreeSlot()
PrepareSlot ndx, Key, HCode, LastNdx
Else
Create = False
End If
GetSlotIndex = ndx
End Function
Private Function GetFreeSlot() As Long
If FreeNdx = 0 Then ExpandSlotTable mChunkSize
GetFreeSlot = FreeNdx
FreeNdx = slotTable(GetFreeSlot).nextItem
slotTable(GetFreeSlot).nextItem = 0
mCount = mCount + 1
End Function
Private Sub PrepareSlot(ByVal index As Long, ByVal Key As String, ByVal HCode As Long, ByVal LastNdx As Long)
If mIgnoreCase Then Key = UCase$(Key)
slotTable(index).Key = Key
If LastNdx Then
slotTable(LastNdx).nextItem = index
Else
hashTbl(HCode) = index
End If
End Sub
责任编辑：小草
