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

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

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

%>

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

转载于:http://blog.itpub.net/10752043/viewspace-992756/