（原创）同Scripting.Dictionary等价的字典类

写此类的原因是因为个人所写的"模版类".,因为很多免费的个人主页空间(因为阿拉穷啊,没钱买空间啊=.=)都不提供FSO.所以导致Scripting.Dictionary也不能使用,所以那"模版类"就不能运行了.于是就有了自己写一个"字典类"的念头.

此类同Scripting.Dictionary对象的使用没有任何的区别,所以以前是根据Scripting.Dictionary来写的程序,不用怎样的修改就可以使用到此类上.此类并且还比Scripting.Dictionary多了一个Insert方法:Insert(sKey,nKey,nval,nMethod),此方法是将新字典数据插入到存在的以sKey为Key的字典位置.nKey,nVal是新字典数据的Key值和Value值.nMethod则是插入的位置.如果此值为1,"b","black"或空值,则是插入到以sKey为Key的字典数据后面,否则前面.

代码如下:

'/*====================字典对象类============================================
'/*作者:死在水中的鱼
'/*日期:2004年7月14日.晚
'/*Blog:http://blog.lznews.cn/blog.asp?name=哇哇鱼
'/*版本:1.00 
'/*用法:
'/*Dim objDic,sKey,I,sValue
'/*Set objDic=New DictionaryClass
'/*Add方法:Add(字典的Key值,字典数据)    说明:如果"字典的Key值"已存在则Add方法失败
'/*objDic.Add "a","字母a"       'Add方法
'/*objDic.Add "b","字母b"    
'/*objDic.Add "c","字母c"
'/*'Insert方法:Insert(被插入位置的Key值,新的字典Key值,新的字典数据,插入方式:b后面,f前面)
'/*objDic.Insert "a","aa","字母aa","b"   
'/*objDic.Insert "b","bb","字母bb","f"
'/*'Exists方法,返回是否存在以"b"为Key值的字典数据
'/*Response.Write objDic.Exists("b")
'/*sKey=objDic.Keys             '获取Keys集合,(数组集合)
'/*sValue=objDic.Items          '获取字典数据集合(数组集合)
'/*objDic.Item("a")="aaaaaa"    'Item属性方法:返回或设置对应Key的字典数据
'/*For I=0 To objDic.Count-1    'Count属性返回有多少条字典数据
'/*    'Item属性方法:返回或设置对应Key的字典数据
'/*    Response.Write objDic.Item(sKey(I))&"<br>"
'/*Next
'/*Remove方法:Remove(字典的Key值)
'/*objDic.Remove("a")           '删除Key值为a的字典数据
'/*objDic.RemoveAll             '清空字典数据
'/*objDic.ErrCode               '返回操作字典时的一些错误代码(调试时用)
'/*objDic.ClearErr              '清空错误代码(调试时用)
'/*Set objDic=nothing
'/*说明:
'/*"字典的Key值":除了Add方法外,都可以用字符串或序数(1,2..)使用
'/* 转载时或修改时,请尊重作者的知识产权,保留此说明!
'/*==========================================================================
Class DictionaryClass
Dim ArryObj()        '使用该二维数组来做存放数据的字典
Dim MaxIndex          'MaxIndex则是ArryObj开始的最大上标
Dim CurIndex          '字典指针,用来指向ArryObj的指针
Dim C_ErrCode           '错误代码号

Private Sub Class_Initialize
  CurIndex=0          '从下标0开始
  C_ErrCode=0           '0表示没有任何错误
  MaxIndex=50         '默认的大小
  Redim ArryObj(1,MaxIndex)   '定义一个二维的数组
End Sub

Private Sub Class_Terminate 
 Erase ArryObj    '清除数组
End Sub

Public Property Get ErrCode  '返回错误代码
   ErrCode=C_ErrCode
End Property

Public Property Get Count    '返回数据的总数,只返回CurIndex当前值-1即可.
   Count=CurIndex
End Property

Public Property Get Keys     '返回字典数据的全部Keys,返回数组.
   Dim KeyCount,ArryKey(),I
   KeyCount=CurIndex-1
   Redim ArryKey(KeyCount)
   For I=0 To KeyCount
       ArryKey(I)=ArryObj(0,I)
   Next
   Keys=ArryKey
   Erase ArryKey
End Property

Public Property Get Items    '返回字典数据的全部Values,返回数组.
   Dim KeyCount,ArryItem(),I
   KeyCount=CurIndex-1
   Redim ArryItem(KeyCount)
   For I=0 To KeyCount
      If isObject(ArryObj(1,I)) Then
         Set ArryItem(I)=ArryObj(1,I)
   Else
      ArryItem(I)=ArryObj(1,I)
   End If
   Next
   Items=ArryItem
   Erase ArryItem
End Property

Public Property Let Item(sKey,sVal)  '取得sKey为Key的字典数据
   If sIsEmpty(sKey) Then
   Exit Property
   End If
   Dim i,iType
   iType=GetType(sKey)
   If iType=1 Then  '如果sKey为数值型的则检查范围
     If sKey>CurIndex Or sKey<1 Then
   C_ErrCode=2
      Exit Property
  End If
   End If
   If iType=0 Then
     For i=0 to CurIndex-1
       If ArryObj(0,i)=sKey Then
       If isObject(sVal) Then
          Set ArryObj(1,i)=sVal
    Else
       ArryObj(1,i)=sVal
    End If
    Exit Property
    End If
     Next
   ElseIf iType=1 Then
          sKey=sKey-1
       If isObject(sVal) Then
          Set ArryObj(1,sKey)=sVal
    Else
       ArryObj(1,sKey)=sVal
    End If
    Exit Property
   End If
   C_ErrCode=2            'ErrCode为2则是替换或个为sKey的字典数据时找不到数据
End Property

Public Property Get Item(sKey)
   If sIsEmpty(sKey) Then
      Item=Null
   Exit Property
   End If
   Dim i,iType
   iType=GetType(sKey)
   If iType=1 Then  '如果sKey为数值型的则检查范围
     If sKey>CurIndex Or sKey<1 Then
      Item=Null
   Exit Property
  End If
   End If
   If iType=0 Then
     For i=0 to CurIndex-1
       If ArryObj(0,i)=sKey Then
       If isObject(ArryObj(1,i)) Then
          Set Item=ArryObj(1,i)
    Else
       Item=ArryObj(1,i)
    End If
    Exit Property
    End If
     Next
   ElseIf iType=1 Then
          sKey=sKey-1
       If isObject(ArryObj(1,sKey)) Then
          Set Item=ArryObj(1,sKey)
    Else
       Item=ArryObj(1,sKey)
    End If
    Exit Property
   End If
   Item=Null
End Property

Public Sub Add(sKey,sVal)  '添加字典
    'On Error Resume Next
    If Exists(sKey) Or C_ErrCode=9 Then
    C_ErrCode=1                 'Key值不唯一(空的Key值也不能添加数字)
    Exit Sub
 End If
    If CurIndex>MaxIndex Then
    MaxIndex=MaxIndex+1         '每次增加一个标数,可以按场合需求改为所需量
    Redim Preserve ArryObj(1,MaxIndex)
 End If
 ArryObj(0,CurIndex)=Cstr(sKey)       'sKey是标识值,将Key以字符串类型保存
 if isObject(sVal) Then
    Set ArryObj(1,CurIndex)=sVal       'sVal是数据
 Else
    ArryObj(1,CurIndex)=sVal       'sVal是数据
 End If
 CurIndex=CurIndex+1
End Sub

'/*==========================================================================
'/*函数作用:插入新的字典数据
'/*参数:sKey=被插入的Key值  nKey=新字典的Key值  nVal=新字典的数据
'/*     sMethod=插入的方式{1,"b","back"}=在sKey的后面位置插入新数据,其它则是前面
'/*==========================================================================
Public Sub Insert(sKey,nKey,nVal,sMethod)
 If Not Exists(sKey) Then
    C_ErrCode=4
    Exit Sub
 End If
    If Exists(nKey) Or C_ErrCode=9 Then
    C_ErrCode=4                 'Key值不唯一(空的Key值也不能添加数字)
    Exit Sub
 End If
 sType=GetType(sKey)              '取得sKey的变量类型
 Dim ArryResult(),I,sType,subIndex,sAdd
 ReDim ArryResult(1,CurIndex)   '定义一个数组用来做临时存放地
 if sIsEmpty(sMethod) Then sMethod="b"    '为空的数据则默认是"b"
 sMethod=lcase(cstr(sMethod))
 subIndex=CurIndex-1
 sAdd=0
 If sType=0 Then                  '字符串类型比较
   If sMethod="1" Or sMethod="b" Or sMethod="back" Then '将数据插入sKey的后面
        For I=0 TO subIndex
           ArryResult(0,sAdd)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,sAdd)=ArryObj(1,I)
     Else
       ArryResult(1,sAdd)=ArryObj(1,I)
     End If
     If ArryObj(0,I)=sKey Then  '插入数据
       sAdd=sAdd+1
       ArryResult(0,sAdd)=nKey
    If IsObject(nVal) Then
      Set ArryResult(1,sAdd)=nVal
    Else
      ArryResult(1,sAdd)=nVal
    End If
     End If
     sAdd=sAdd+1
     Next
   Else
        For I=0 TO subIndex
     If ArryObj(0,I)=sKey Then  '插入数据
       ArryResult(0,sAdd)=nKey
    If IsObject(nVal) Then
      Set ArryResult(1,sAdd)=nVal
    Else
      ArryResult(1,sAdd)=nVal
    End If
    sAdd=sAdd+1
     End If
     ArryResult(0,sAdd)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,sAdd)=ArryObj(1,I)
     Else
       ArryResult(1,sAdd)=ArryObj(1,I)
     End If
     sAdd=sAdd+1
     Next
   End If
 ElseIf sType=1 Then
   sKey=sKey-1                    '减1是为了符合日常习惯(从1开始)
   If sMethod="1" Or sMethod="b" Or sMethod="back" Then '将数据插入sKey的后面
        For I=0 TO sKey              '取sKey前面部分数据
           ArryResult(0,I)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,I)=ArryObj(1,I)
     Else
       ArryResult(1,I)=ArryObj(1,I)
     End If
     Next
  '插入新的数据
  ArryResult(0,sKey+1)=nKey
  If IsObject(nVal) Then
     Set ArryResult(1,sKey+1)=nVal
  Else
     ArryResult(1,sKey+1)=nVal
  End If
  '取sKey后面的数据
        For I=sKey+1 TO subIndex
           ArryResult(0,I+1)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,I+1)=ArryObj(1,I)
     Else
       ArryResult(1,I+1)=ArryObj(1,I)
     End If
     Next
   Else
        For I=0 TO sKey-1              '取sKey-1前面部分数据
           ArryResult(0,I)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,I)=ArryObj(1,I)
     Else
       ArryResult(1,I)=ArryObj(1,I)
     End If
     Next
  '插入新的数据
  ArryResult(0,sKey)=nKey
  If IsObject(nVal) Then
     Set ArryResult(1,sKey)=nVal
  Else
     ArryResult(1,sKey)=nVal
  End If
  '取sKey后面的数据
        For I=sKey TO subIndex
           ArryResult(0,I+1)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,I+1)=ArryObj(1,I)
     Else
       ArryResult(1,I+1)=ArryObj(1,I)
     End If
     Next
   End If
 Else
   C_ErrCode=3
   Exit Sub
 End If
 ReDim ArryObj(1,CurIndex)  '重置数据
 For I=0 To CurIndex
  ArryObj(0,I)=ArryResult(0,I)
  If isObject(ArryResult(1,I)) Then
     Set ArryObj(1,I)=ArryResult(1,I)
  Else
     ArryObj(1,I)=ArryResult(1,I)
  End If
 Next
 MaxIndex=CurIndex
 Erase ArryResult
 CurIndex=CurIndex+1      'Insert后数据指针加一
End Sub

Public Function Exists(sKey)   '判断存不存在某个字典数据
    If sIsEmpty(sKey) Then
       Exists=False
       Exit Function
 End If
 Dim I,vType
 vType=GetType(sKey)
 If vType=0 Then
   For I=0 To CurIndex-1
     If ArryObj(0,I)=sKey Then
     Exists=True
     Exit Function
  End If
   Next
 ElseIf vType=1 Then
      If sKey<=CurIndex And sKey>0 Then
      Exists=True
      Exit Function
   End If
 End If
 Exists=False
End Function

Public Sub Remove(sKey)              '根据sKey的值Remove一条字典数据
 If Not Exists(sKey) Then
    C_ErrCode=3
    Exit Sub
 End If
 sType=GetType(sKey)              '取得sKey的变量类型
 Dim ArryResult(),I,sType,sAdd
 ReDim ArryResult(1,CurIndex-2)   '定义一个数组用来做临时存放地
 sAdd=0
 If sType=0 Then                  '字符串类型比较
      For I=0 TO CurIndex-1
     If ArryObj(0,I)<>sKey Then
           ArryResult(0,sAdd)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,sAdd)=ArryObj(1,I)
     Else
       ArryResult(1,sAdd)=ArryObj(1,I)
     End If
     sAdd=sAdd+1
  End If
   Next
 ElseIf sType=1 Then
   sKey=sKey-1                    '减1是为了符合日常习惯(从1开始)
      For I=0 TO CurIndex-1
     If I<>sKey Then
           ArryResult(0,sAdd)=ArryObj(0,I)
     If IsObject(ArryObj(1,I)) Then
       Set ArryResult(1,sAdd)=ArryObj(1,I)
     Else
       ArryResult(1,sAdd)=ArryObj(1,I)
     End If
     sAdd=sAdd+1
  End If
   Next
 Else
   C_ErrCode=3
   Exit Sub
 End If
 MaxIndex=CurIndex-2
 ReDim ArryObj(1,MaxIndex)  '重置数据
 For I=0 To MaxIndex
  ArryObj(0,I)=ArryResult(0,I)
  If isObject(ArryResult(1,I)) Then
     Set ArryObj(1,I)=ArryResult(1,I)
  Else
     ArryObj(1,I)=ArryResult(1,I)
  End If
 Next
 Erase ArryResult
 CurIndex=CurIndex-1      '减一是Remove后数据指针
End Sub

Public Sub RemoveAll  '全部清空字典数据,只Redim一下就OK了
    Redim ArryObj(MaxIndex)
 CurIndex=0
End Sub

Public Sub ClearErr   '重置错误
    C_ErrCode=0
End Sub

Private Function sIsEmpty(sVal)  '判断sVal是否为空值
    If IsEmpty(sVal) Then
    C_ErrCode=9                 'Key值为空的错误代码
    sIsEmpty=True
    Exit Function
 End If
    If IsNull(sVal) Then
    C_ErrCode=9                 'Key值为空的错误代码
    sIsEmpty=True
    Exit Function
 End If
    If Trim(sVal)="" Then
    C_ErrCode=9                 'Key值为空的错误代码
    sIsEmpty=True
    Exit Function
 End If
 sIsEmpty=False
End Function

Private Function GetType(sVal)     '取得变量sVal的变量类型
    dim sType
 sType=TypeName(sVal)
    Select Case sType
    Case "String"
       GetType=0
    Case "Integer","Long","Single","Double"
       GetType=1
    Case Else
       GetType=-1
 End Select
End Function

End Class