Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As Long)
Const DEFAULT_HASHSIZE = 1024
Const DEFAULT_LISTSIZE = 2048
Const DEFAULT_CHUNKSIZE = 1024
Option Explicit
Private Type SlotType
Key As String
Value As Variant
nextItem As Long
End Type
Dim hashTbl() As Long
Dim slotTable() As SlotType
Dim FreeNdx As Long
Dim mHashSize As Long
Dim mListSize As Long
Dim mChunkSize As Long
Dim mCount As Long
Private mIgnoreCase As Boolean
Property Get IgnoreCase() As Boolean
IgnoreCase = mIgnoreCase
End Property
Property Let IgnoreCase(ByVal newValue As Boolean)
If mCount Then
Err.Raise 2000, "The Hash Table isn’t empty!"
End If
mIgnoreCase = newValue
End Property
Sub SetSize(ByVal HashSize As Long, Optional ByVal ListSize As Long, Optional ByVal ChunkSize As Long)
If ListSize <= 0 Then ListSize = mListSize
If ChunkSize <= 0 Then ChunkSize = mChunkSize
mHashSize = HashSize
mListSize = ListSize
mChunkSize = ChunkSize
mCount = 0
FreeNdx = 0
ReDim hashTbl(0 To HashSize - 1) As Long
ReDim slotTable(0) As SlotType
ExpandSlotTable mListSize
End Sub
Function Exists(Key As String) As Boolean
Exists = GetSlotIndex(Key) <> 0
End Function
Sub Add(Key As String, Value As Variant)
Dim ndx As Long, Create As Boolean
Create = True
ndx = GetSlotIndex(Key, Create)
If Create Then
If IsObject(Value) Then
Set slotTable(ndx).Value = Value
Else
slotTable(ndx).Value = Value
End If
Else
’Err.Raise 457
Exit Sub
End If
End Sub
Property Get GetKey(index As Long) As String
GetKey = slotTable(index + 1).Key
End Property
Property Get Item(Key As String) As Variant
Dim ndx As Long
ndx = GetSlotIndex(Key)
If ndx = 0 Then
ElseIf IsObject(slotTable(ndx).Value) Then
Set Item = slotTable(ndx).Value
Else
Item = slotTable(ndx).Value
End If
End Property
Property Let Item(Key As String, Value As Variant)
Dim ndx As Long
ndx = GetSlotIndex(Key, True)
slotTable(ndx).Value = Value
End Property
Property Set Item(Key As String, Value As Object)
Dim ndx As Long
ndx = GetSlotIndex(Key, True)
Set slotTable(ndx).Value = Value
End Property
责任编辑：小草
