同Scriptiing.Dictionary等价的字典类

同Scriptiing.Dictionary等价的字典类2009-12-12哇哇鱼写些类的原因是因为个人所写的"模版类".,因为很多免费的个人主页空间（因为阿拉穷啊,没钱买空间啊=.=）都不提供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