您的位置:首页 > 其它

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

2014-04-23 09:27 134 查看
存储数据键和项目对的类(Dictionary对象)
<% 

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 Sub
Public 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 Property
Property 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 Property
Property 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 Function
Private Function DeleteSort(sKey) 

Dim iTop,I,iLen 

iTop=BinSearch(sKey) 

If iTop=0 Then 

Err.Raise
End Function
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: