用自定义类实现vbs中Dictionary的功能

关于这个类的相关说明请参照这篇[关于自定义Dictionary类的说明]

<%



'**********************************************

' File:  Dictionary.asp

' Version: willpower Dictionary Class Version 0.1 Build 20080424

' Author: willpower

' Email: wise.willpower@163.com

' QQ:20934440

' Date:  04/30/2008

' Comments: The code for the dictionary.

'   This can free usage, but please

'   not to delete this copyright information.

'   If you have a modification version,

'   Please send out a duplicate to me.

'**********************************************

' 文件名: Dictionary.asp

' 版本:  willpower Dictionary Class Version 0.1 Build 20080424

' 作者:  willpower(wise.willpower)

' 电子邮件: wise.willpower@163.com

' QQ:20934440

' 日期:  2008年04月30日

' 声明:  字典类

'   本字典类可以自由使用，但请保留此版权声明信息

'   如果您对本字典类进行修改增强，

'   请发送一份给俺。





Class Dictionary

'declare private variables 

Private arrKey(100)   ' Define a Array , Contains the index|定义一个数组用来存储集合索引,数组大小由与Hash表大小一样,这里定为100

Private intCount   ' Define a Integer, Store the Collection's count|定义一个整型变量来存储键值对的个数



Private Sub Class_Initialize()

Call RemoveAll()

End Sub



Private Sub Class_Terminate()

Call RemoveAll()

End Sub



Public Function RemoveAll()

intCount = 0

Erase arrKey

End Function



Public Function Add(ByVal strKey,ByVal strItem)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Function

End If

If Not Exists(strKey) Then

Dim t

t = CHash(strKey)  ' Define t as temporary variable to restore the CHash result|定义一个临时变量来存储Chash返回的值．用空间来节省时间．

If Not IsObject(arrKey(t)) Then ' 检测有没有冲突[这里一定要用IsObject]

Set arrKey(t) = New Data

arrKey(t).DataKey = strKey

If Not IsObject(strItem) Then

arrKey(t).DataItem = strItem

Else

Set arrKey(t).DataItem = strItem

End If

Else

Dim tObject

Set tObject = arrKey(t)

While IsObject(tObject.NextNode)

Set tObject=tObject.NextNode

Wend

Set tObject.NextNode = New Data

Set tObject = tObject.NextNode

tObject.DataKey = strKey

If Not IsObject(strItem) Then

tObject.DataItem = strItem

Else

Set tObject.DataItem = strItem

End If

Set tObject = Nothing

End If

intCount = intCount + 1

Else

err.Raise 2,"Dictionary","The Key is already exist!"

End If

End Function





Public Function Remove(ByVal strKey)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Function

End If



If Not Exists(strKey) Then

err.Raise 3,"Dictionary","The Key is not exist!"

Else

Dim t

t = CHash(strKey)



If arrKey(t).DataKey = strKey Then

If IsObject(arrKey(t).DataItem) Then

Set arrKey(t).DataItem = Nothing

End If

If Not IsObject(arrKey(t).NextNode) Then

Set arrKey(t) = Nothing

arrKey(t) = 0

Else

Set arrKey(t) = arrKey(t).NextNode

End If

intCount = intCount - 1

Else



Dim tObjectPre,tObject

Set tObject = arrKey(t)

Do While IsObject(tObject.NextNode)

If tObject.NextNode.DataKey = strKey Then

Set tObjectPre = tObject

If IsObject(tObject.DataItem) Then

Set tObject.DataItem = Nothing

End If

If IsObject(tObject.NextNode) Then

Set tObjectPre = tObject.NextNode

Else

tObjectPre.NextNode = 0

End If

Set tObjectPre = Nothing

Set tObject = Nothing

intCount = intCount - 1

Exit Do

End If

Loop

End If



End If

End Function





Public Function Keys()

Dim tArr

ReDim tArr(intCount-1)

Dim i

i = 0

For j = 0 To 100

If IsObject(arrKey(j)) Then

Dim tObject

Set tObject = arrKey(j)

tArr(i) = tObject.DataKey

i = i + 1

While IsObject(tObject.NextNode)

Set tObject = tObject.NextNode

tArr(i) = tObject.DataKey

i = i + 1

Wend

Set tObject = Nothing

End If

Next

Keys = tArr

End Function





Public Function Items()

Dim tArr

ReDim tArr(intCount-1)

Dim i

i = 0

For j = 0 To 100

If IsObject(arrKey(j)) Then

Dim tObject

Set tObject = arrKey(j)

If Not IsObject(tObject.DataItem) Then

tArr(i) = tObject.DataItem

Else

Set tArr(i) = tObject.DataItem

End If

i = i + 1

While IsObject(tObject.NextNode)

Set tObject = tObject.NextNode

If Not IsObject(tObject.DataItem) Then

tArr(i) = tObject.DataItem

Else

Set tArr(i) = tObject.DataItem

End If

i = i + 1

Wend

Set tObject = Nothing

End If

Next

Items = tArr

End Function





Private Function Search(ByVal strKey)

Search = False

Dim t

t = CHash(strKey)

If IsObject(arrKey(t)) Then

If arrKey(t).DataKey = strKey Then

Set Search = arrKey(t)

Else

Dim tObject

Set tObject = arrKey(t)

Do While IsObject(tObject.NextNode)

Set tObject = tObject.NextNode

If tObject.DataKey = strKey Then

Set Search = tObject

Set tObject = Nothing

Exit Do

End If

Loop

End If

End If

End Function





Public Function Exists(ByVal strKey)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Function

End If

Exists = False

If IsObject(Search(strKey)) Then

Exists = True

End If

End Function





Private Function CHash(ByVal strKey)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Function

End If

Dim i,t,s,l,quotient,istep,divisor     ' i:increment,t:temporary variable,s:CHash return value,l:string's length|i:增量,t:临时变量，用来临时存储任意一个字符的ASC码,s:存储符合条件的ASC码的和,l:字符串的长度

divisor = 101

i = 0        

t = 0

s = 0

l = Len(strKey)

quotient = l / 4        '不知可否用右移来使它更快

istep = quotient + 1

For i = 1 To l step istep

t = Asc(Mid(strKey,i,1))

s = s + t

Next

CHash = s mod divisor

End Function



Public Property Get Count

Count = intCount

End Property



Public Property Get Item(ByVal strKey)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Property

End If

Dim tObject

If IsObject(Search(strKey)) Then

Set tObject = Search(strKey)

If IsObject(tObject.DataItem) Then

Set Item = tObject.DataItem

Else

Item = tObject.DataItem

Set tObject = Nothing

End If

Else

err.Raise 3,"Dictionary","The Key is not exist!"

Exit Property

End If

End Property



Public Property Let Item(ByVal strKey,ByVal strItem)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Property

End If

If IsObject(Search(strKey)) Then

Set tObject = Search(strKey)

Item = tObject.DataItem

Set tObject = Nothing

Else

err.Raise 3,"Dictionary","The Key is not exist!"

Exit Property

End If

End Property



Public Property Set Item(ByVal strKey,ByRef oItem)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Property

End If

If IsObject(Search(strKey)) Then

Set tObject = Search(strKey)

Set Item = tObject.DataItem

Set tObject = Nothing

Else

err.Raise 3,"Dictionary","The Key is not exist!"

Exit Property

End If

End Property





Public Property Let Key(ByVal strKey,ByVal str)

If strKey = "" Then

err.Raise 1,"Dictionary","Key's value must not be empty!"

Exit Property

End If

If IsObject(Search(strKey)) Then

Set tObject = Search(strKey)

Item = tObject.DataKey

Set tObject = Nothing

Else

err.Raise 3,"Dictionary","The Key is not exist!"

Exit Property

End If

End Property

End Class



 



Class Data



Public DataKey

Public DataItem

Public NextNode



Private Sub Class_Initialize()

Call RemoveAll()

End Sub



Private Sub Class_Terminate()

Call RemoveAll()

End Sub



Private Sub RemoveAll()

DataKey = ""

DataItem = Empty

NextNode = Null

End Sub



End Class





dim s1

Set s1 = New Dictionary

s1.Add "userName","willpower"

s1.Add "userTel",123456

s1.Add "IsVisible",True

s1.Add "addTime",Now()

Dim arr,i

arr = s1.Items()

For i = 0 To Ubound(arr)

Response.Write arr(i)

Next

Set s1 = Nothing%>