<% '############################################################################ '# # '# 存储数据键和项目对的类(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
%> 
|