<%
'############################################################################
'# #
'# 存储数据键和项目对的类（Dictionary对象） #
'# #
'# 本类功能用法完全按照 Microsoft Visual Basic Scripting Edition #
'# 中的Dictionary对象编写，使用本类完全可以参照其的功能和用法。 #
'# 下面便是该对象的中文使用说明 #
'# http://www.microsoft.com/china/vbscript/vbslang/vsobjDictionary.htm #
'# 本类完全由简单的VBscript编写，所以您可以在任何支持ASP的空间使用它 #
'# 从而获的使用Dictionary对象的便利。 #
'# 您可以随意使用，但请保留版权信息！谢谢！ #
'# #
'# 编写者：ChinaOK #
'# Http://www.ChinaOK.net #
'# 2002.8.3 #
'# #
'############################################################################
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 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 Function
Private 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 Sub
End Class
%>
本文地址：http://com.8s8s.com/it/it9252.htm