存储数据键和项目对的类（Dictionary对象）
存储数据键和项目对的类（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","设置字符串keyword比較模式必须在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
