儲存資料鍵和專案對的類（Dictionary物件） (轉)

儲存資料鍵和專案對的類（Dictionary物件） (轉)[@more@]

'############################################################################
'# #
'# 資料鍵和專案對的類（Dictionary） #
'# #
'# 本類功能用法完全按照 Scripting Edition #
'# 中的Dictionary物件編寫，使用本類完全可以參照其的功能和用法。 # 
'#  下面便是該物件的中文使用說明 #
'#  /vbslang/vsobjDictionary.htm"> #
'# 本類完全由簡單的VBscript編寫，所以您可以在任何支援的空間使用它 #
'#  從而獲的使用Dictionary物件的便利。 #
'# 您可以隨意使用，但請保留版權資訊！謝謝！ #
'# #
'# 編寫者：ChinaOK #
'# "> #
'# 2002.8.3 #
'# #
'############################################################################
 

 
Class Dictionary

Public Copyright, Developer, Name, Version,

Private aryKey()
Private aryItem()
Private iCompareMode

Private Sub Class_Initialize()
 '請保留此資訊
 Copyright = "2002 , All rights reserved."
 Developer = "ChinaOK"
 Name = "Dictionary"
 Version = "1.0b"
 Web = ""
 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
 L
 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_Tenate() 
 
End Sub

End Class

%>