Dictionary classes equivalent to Scriptiing.dictionary

The reason for writing classes is because of the "template class" that is written by the individual. Because many free personal homepage space (because of Allah poor, no money to buy space ah =.=) do not provide FSO. So the scripting.dictionary can't be used, so "template class" It's not going to work. So there is the idea of writing a "dictionary" of your own.

There is no difference in the use of this similar Scripting.Dictionary object, so it was previously written according to Scripting.Dictionary, You can use this class without any modification. This class is also more than scripting.dictionary an Insert method: Insert (Skey,nkey, Nval,nmethod), This method inserts the new dictionary data into the existing dictionary location with Skey as key. Nkey,nval is the key and value value of the new dictionary data. Nmethod is the location of the insertion. If this value is 1, "B", "BLACK" or a null value, is inserted behind the dictionary data with Skey as key, otherwise before.

The code is as follows:

'/*==================== Dictionary object class ============================================
"* * Author: Dead Fish in the water
'/* Date: July 14, 2004. Late
"/*blog:http://blog.lznews.cn/blog.asp?name=-wah Fish
' * * Version: 1.00
'/* Usage:
"'/*dim Objdic,skey,i,svalue
"'/*set objdic=new Dictionaryclass
'/*add method: Add (Dictionary key value, dictionary data) Description: If "Dictionary key value" already exists the Add method fails
'/*objdic.add ' a ', ' the letter A ' ' Add method
"/*objdic.add" B "," Letter B "
"/*objdic.add" C "," Letter C "
'/* ' Insert method: Insert (key value of inserted position, new dictionary key value, new dictionary data, insert method: B behind, F front)
'/*objdic.insert ' a ', ' AA ', ' Letter aa ', ' B '
"/*objdic.insert" b "," BB "," Letter Bb "," F "
'/* ' exists method that returns the existence of a dictionary data with "B" as the key value
'/*response.write objdic.exists ("B")
'/*skey=objdic.keys ' gets the Keys collection, (Array collection)
'/*svalue=objdic.items ' gets the Dictionary data collection (array collection)
'/*objdic.item (' a ') = ' aaaaaa ' ' Item Property method: Returns or sets the dictionary data for the corresponding key
'/*for i=0 to Objdic.count-1 ' Count property returns how many dictionary data
'/* ' Item property Method: Returns or sets the dictionary data for the corresponding key
'/* Response.Write Objdic.item (SKey (I)) & "<br>"
"'/*next
'/*remove method: Remove (dictionary key value)
'/*objdic.remove (' a ') ' deletes the dictionary data for key value a
'/*objdic.removeall ' clears the dictionary data
'/*objdic.errcode ' returns some error codes when manipulating the dictionary (used when debugging)
'/*objdic.clearerr ' clears the error code (used when debugging)
"'/*set objdic=nothing
'/* Description:
'/* ' dictionary key value: In addition to the Add method, you can use a string or ordinal (1,2 ...) Use
"* * Reproduced or modified, please respect the author's intellectual property rights, keep this note!
''/*==========================================================================
Class Dictionaryclass
Dim arryobj () ' uses the two-dimensional array to do the dictionary for storing data
Dim Maxindex ' Maxindex is the largest superscript of the arryobj start
Dim curindex ' dictionary pointer, used to point to arryobj pointer
Dim C_errcode ' Error code number

Private Sub Class_Initialize
Curindex=0 ' starts with subscript 0
C_errcode=0 ' 0 means there's no mistake.
Maxindex=50 ' Default size
Redim arryobj (1,maxindex) ' defines a two-dimensional array
End Sub

Private Sub Class_Terminate
Erase arryobj ' clears the array
End Sub

Public Property Get Errcode ' Returns an error code
Errcode=c_errcode
End Property

Public Property Get Count ' Returns the total number of data, returning only Curindex current value-1.
Count=curindex
End Property

The public Property Get Keys ' Returns the entire Keys of the dictionary data, returning an array.
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 ' Returns all values of the dictionary data, returning the array.
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) ' Gets the dictionary data SKey as key
If sisempty (SKey) Then
Exit Property
End If
Dim I,itype
Itype=gettype (SKey)
If itype=1 Then ' if Skey is a numeric type check range
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 is 2 is a replacement or a Skey dictionary data cannot find data
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 ' if Skey is a numeric type check range
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) ' Add dictionary
' On Error Resume Next
If Exists (SKey) Or c_errcode=9 Then
C_errcode=1 ' key value is not unique (empty key value cannot add number)
Exit Sub
End If
If Curindex>maxindex Then
Maxindex=maxindex+1 ' ' Each time you add a scale, you can change the demand to the required amount according to the situation.
Redim Preserve arryobj (1,maxindex)
End If
Arryobj (0,curindex) =cstr (SKey) ' SKey is an identity value that holds the key as a string type
If IsObject (sval) Then
Set arryobj (1,curindex) =sval ' Sval is data
Else
Arryobj (1,curindex) =sval ' Sval is data
End If
Curindex=curindex+1
End Sub

''/*==========================================================================
'/* Function function: Insert new dictionary data
'/* parameter: skey= inserted key value nkey= new Dictionary key value nval= new dictionary data
'/* smethod= insert mode {1, ' B ', ' Back '}= inserts new data at the rear of Skey, others are front
''/*==========================================================================
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 value is not unique (empty key value cannot add number)
Exit Sub
End If
Stype=gettype (SKey) ' To get SKey variable type
Dim Arryresult (), I,stype,subindex,sadd
ReDim Arryresult (1,curindex) "defines an array for temporary storage.
If Sisempty (smethod) Then smethod= "B" is null, the default is "B"
Smethod=lcase (CStr (Smethod))
Subindex=curindex-1
Sadd=0
If stype=0 Then ' string type comparison
If smethod= "1" or smethod= "B" or smethod= "back" Then "inserts the data behind the 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 ' Insert data
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 ' Insert data
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 ' minus 1 is to conform to daily habits (starting from 1)
If smethod= "1" or smethod= "B" or smethod= "back" Then "inserts the data behind the Skey
For i=0 to SKey ' take SKey previous part of the data
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
"Insert the new data
Arryresult (0,skey+1) =nkey
If IsObject (nval) Then
Set Arryresult (1,skey+1) =nval
Else
Arryresult (1,skey+1) =nval
End If
"Take the data after 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 ' take sKey-1 previous part of the data
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
"Insert the new data
Arryresult (0,skey) =nkey
If IsObject (nval) Then
Set Arryresult (1,skey) =nval
Else
Arryresult (1,skey) =nval
End If
"Take the data after 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) ' Reset data
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 data pointer plus a
End Sub

Public Function Exists (SKey) ' determines that there is no dictionary data stored
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) ' Removes a dictionary data based on the value of SKey
If not Exists (SKey) Then
C_errcode=3
Exit Sub
End If
Stype=gettype (SKey) ' To get SKey variable type
Dim Arryresult (), I,stype,sadd
ReDim Arryresult (1,curindex-2) "defines an array for temporary storage.
Sadd=0
If stype=0 Then ' string type comparison
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 ' minus 1 is to conform to daily habits (starting from 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) ' Reset data
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 ' Minus one is the data pointer after remove
End Sub

Public Sub removeall ' All empty dictionary data, just ReDim it's OK
Redim Arryobj (Maxindex)
Curindex=0
End Sub

Public Sub clearerr ' Reset Error
C_errcode=0
End Sub

Private Function sisempty (sval) ' Determines whether the sval is a null value
If IsEmpty (sval) Then
C_errcode=9 ' key value is null error code
Sisempty=true
Exit Function
End If
If IsNull (sval) Then
C_errcode=9 ' key value is null error code
Sisempty=true
Exit Function
End If
If Trim (sval) = "" Then
C_errcode=9 ' key value is null error code
Sisempty=true
Exit Function
End If
Sisempty=false
End Function

Private Function GetType (sval) ' To get variable sval variable type
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