星星博客 - Powered by Discuz! Board

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
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

复制代码