test.frm

VB编写的HashTable

VERSION 5.00
Begin VB.Form Test 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "Test"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Load()
'
'Dim George As New Hashtable
'Dim Dennis As New Hashtable
'
'   George("First Name") = "George"
'   George("Last Name") = "Wilson"
'   George("Age") = 45
'   George("Demeanor") = "Irate"
'
'   Dennis("First Name") = "Dennis"
'   Dennis("Last Name") = "The Meanace"
'   Dennis("Age") = "Young"
'
'   Set Dennis("Target") = George
'
'   Debug.Print Dennis("Target")("First Name")  'Prints George
'
'   Dennis.Remove "Target"
'
'   George.RemoveAll

'Dim h As Hashtable
'Set h = New Hashtable
'Set h("a1") = "yfzhu"
''Dim s As New Dictionary
''s.CompareMode = BinaryCompare
''s.Add "String1", "k1"
''s.Add "String1", "k2"
''Dim c As Variant
''c = s.Item("String1")
'

    
    Dim h As New Hashtable
    Dim c As Variant
    h.Clear
    Set c = h.PutItem("key1", 1)
    If IsNull(c) Then
    Else
        Err.Raise 515, , "c should be null"
    End If
    Dim c2 As Variant
    
    If h.PutItem("key1", 2) = 1 Then
    Else
        Err.Raise 516, , "c should be privious 'key1' value"
    End If
    
'    If h.Count <> 1 Then Err.Raise 517, , "c should has size as 1, since the keys only has one size"
'
'    If h.Values.Count <> 1 Then Err.Raise 518, , "value count should be 1"
'    If h.Values.Item(1) <> 2 Then Err.Raise 519, , "value of the hashtable should be 2 (of 'key1')"
'    If h.GetItem("key1") <> 2 Then Err.Raise 520, , "value of the hashtable should be 2 (of 'key1')"
    
    c = h.PutItem("key2", "3")
    
    If h.GetItem("key2") = "3" Then
    Else
        Err.Raise 521, , "value should be 3"
    End If
    
    If IsNull(h.GetItem("key5")) Then
    Else
        Err.Raise 546, , "value should be null"
    End If
    
    Dim co As New Collection
    Dim cmd As CommandButton
    Set cmd = cmd2
    cmd.Caption = "yfzhu"
    
    co.Add "Number1", "colKey1"
    Dim var As Variant
    Dim key As String
    key = "keyString"
    var = h.PutItem(key, "abc")
    Dim col12 As Variant
    col12 = h.GetItem(key)
    
    key = "keyCollection"
    Set h.Item(key) = cmd
    
    Dim col2 As Variant
    Set col2 = h.GetItem(key)
    If (IsNull(col2)) Then
        Err.Raise 522, , "ByRef value should be identical to out side one"
    End If
    col2.Caption = "ok"
    
    Dim arra
    arra = h.Keys
    Print UBound(arra)
    Print LBound(arra)
    
End Sub