存储数据键和项目对的类（Dictionary对象）(转)

存储数据键和项目对的类（Dictionary对象）(转)[@more@]

　　Class Dictionary

　　Public Copyright, Developer, Name, Version, Web

　　Private aryKey()

　　Private aryItem()

　　Private iCompareMode

　　Private Sub Class_Initialize()

　　'请保留此信息

　　Copyright = "2002 www.ChinaOK.Net, All rights reserved."

　　Developer = "ChinaOK"

　　Name = "Dictionary"

　　Version = "1.0b"

　　Web = "http://www.ChinaOK.Net";

　　Redim aryKey(0)

　　Redim aryItem(0)

　　aryKey(0)=""

　　aryItem(0)=""

　　iCompareMode=0

　　End SubPublic Function Add(sKey,Item)

　　InsertSort sKey,Item

　　End Function

　　Public Function Exists(sKey)

　　If BinSearch(sKey)=0 Then

　　Exists=false

　　Else

　　Exists=True

　　End if

　　End Function

　　Public Function Items()

　　Items=aryItem

　　End Function

　　Public Function Keys()

　　Keys=aryKey

　　End Function

　　Public Function Remove(sKey)

　　DeleteSort sKey

　　End Function

　　Public Function RemoveAll()

　　Redim aryKey(0)

　　Redim aryItem(0)

　　aryKey(0)=""

　　aryItem(0)=""

　　End Function

　　Property Get Count()

　　Dim Len1,Len2

　　Len1=ubound(aryKey)

　　Len2=ubound(aryItem)

　　If Len1<>Len2 Then Redim Preserve aryItem(Len1)

　　Count=Len1

　　End Property

　　Property Get Item(sKey)

　　Dim iTop

　　iTop=0

　　iTop = BinSearch(sKey)

　　If iTop<>0 Then

　　Item=aryItem(iTop)

　　Else

　　Add sKey,""

　　Item=""

　　End If

　　End Property

　　Property Let Item(sKey,NewItem)

　　Dim iTop

　　iTop=0

　　iTop = BinSearch(sKey)

　　If iTop<>0 Then

　　aryItem(iTop)=NewItem

　　Else

　　Add sKey,NewItem

　　End If

　　End Property

　　Property Let Key(sKey,sNewKey)

　　Dim iTop

　　iTop = 0

　　iTop = BinSearch(sKey)

　　If iTop<>0 Then

　　aryKey(iTop)=sNewKey

　　Else

　　Err.Raise 19782,"myDictionary","未找到元素" & sKey,"",0

　　End If

　　End PropertyProperty Let CompareMode(iMode)

　　If Count()>0 Then Err.Raise 19783,"myDictionary","设置字符串关键字比较模式必须在Items为空时设置","",0

　　If (iMode<>0 And iMode<>1) Then iMode=0

　　iCompareMode=iMode

　　End PropertyProperty Get CompareMode()

　　CompareMode=iCompareMode

　　End Property

　　

　　Private Function BinSearch(sKey)

　　'折半查找算法

　　Dim Result

　　Result=0

　　Dim iHigh,iLow,iMid

　　iHigh = Count()

　　iLow = 1

　　Do While (iLow<=iHigh)

　　iMid=(iLow+iHigh)2

　　If strComp(aryKey(iMid),sKey,iCompareMode)=0 Then

　　Result=iMid

　　Exit Do

　　End If

　　If strComp(aryKey(iMid),sKey,iCompareMode)=1 Then

　　iHigh=iMid-1

　　Else

　　iLow=iMid+1

　　End if

　　Loop

　　BinSearch=Result

　　End FunctionPrivate Function DeleteSort(sKey)

　　Dim iTop,I,iLen

　　iTop=BinSearch(sKey)

　　If iTop=0 Then

　　Err.Raise 19782,"myDictionary","未找到元素" & sKey,"",0

　　Else

　　iLen=Count()

　　For I=iTop+1 To iLen

　　aryKey(I-1)=aryKey(I)

　　aryItem(I-1)=aryItem(I)

　　Next

　　Redim Preserve aryKey(iLen-1)

　　Redim Preserve aryItem(iLen-1)

　　End if

　　End FunctionPrivate Function InsertSort(sKey,Item)

　　Dim I,J,iLen

　　iLen=Count()

　　'查找插入 ，直接查找插入算法

　　For I=1 To iLen

　　If (strComp(aryKey(I),sKey,iCompareMode)<>-1) Then

　　Exit For

　　End If

　　Next

　　If (I>iLen) Then

　　'直接插入

　　Redim Preserve aryKey(I)

　　Redim Preserve aryItem(I)

　　aryKey(I)=sKey

　　aryItem(I)=Item

　　Else

　　If (strComp(aryKey(I),sKey,iCompareMode)=0) Then

　　Err.Raise 19781,"myDictionary","此键已与该集合的一个元素关联","",0

　　Else

　　Redim Preserve aryKey(iLen+1)

　　Redim Preserve aryItem(iLen+1)

　　For J=iLen+1 To I+1 Step -1

　　aryKey(J) = aryKey(J-1)

　　aryItem(J)= aryItem(J-1)

　　Next

　　aryKey(I)=sKey

　　aryItem(I)=Item

　　End If

　　End If

　　End Function'类销毁

　　Private Sub Class_Terminate()

　　

　　End SubEnd Class

　　%>

　　

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/8403220/viewspace-954359/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/8403220/viewspace-954359/