过新年，特献薄礼：用VBScript实现的集合类！

特需要使用集合的时候，无法找到 Vbscript 中的 Collection 对象；到处找不到，那就自己写一个吧！

注：
1. 需要 Vbscript 5.0 或更高版本，使用 Class 及动态数组实现；
2. 如果哪位高人能够提供更好的方法，不要忘了回贴告诉在下啊！

下面为源码：
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
' Filename: CollCls.vbs - 集合类定义（模拟集合行为）
' Programmer: zhang_resource
' Built: 2004-01-12
' Last Edited: 2004-01-13
' (c) All Rights Reserved.

' 关于集合类：
' 1. 索引从 1 开始到 Count
' 2. 不支持默认项的语法 objColl("Key"), 只支持 objColl.Item("Key") 的语法
' 3. 提供以下外部方法：
'  - Add() 支持错误捕获
'  - Remove() 支持错误捕获
'  - Item() 支持错误捕获
'  - Count()
'  - Clear()

' 注解：
' 1. Class 的支持自 Vbscript 5.0 开始，包含在 IE5.0（浏览器）、IIS4.0（服务器）及其后续版本中
' 2. 本模块仅用于客户端（IE 浏览器）
'    IE 客户端引用：
'      <ＳＣＲＩＰＴ language="Vbscript" src="CollCls.vbs">
'      

Class clsCollection
' --- Private ---

' 以下 2 个数组用以保存集合元素及其健值 Key 索引，
' 具有相同的数组维数及下标
Private m_ItemArray() ' 用以保存集合元素的数组，可为任意类型的数据
Private m_KeyArray() ' 用以保存集合元素 Key 值的数组，其值为字符串
Private m_Count ' 集合元素的个数

Private Sub Class_Initialize() ' 类初始化
m_Count = 0
ReDim m_ItemArray(0) ' 第 0 个元素将不起作用
ReDim m_KeyArray(0) ' 第 0 个元素将不起作用
End Sub

' --- Public ---

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Add() Method
'' Item_Key: 关键字Key[字符串]，不能重复，不区分大小写
'' Item_Value: 集合元素的值，任意类型
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Add(Item_Key, Item_Value)
Dim i

' 判断加入的元素是否与原来相同
If m_Count > 0 Then
If VarType(m_ItemArray(m_Count)) <> VarType(Item_Value) Then
Add = Null
Err.Raise 111, "CollCls:第53行", "加入的新元素与集合中的元素类型不一致。"
Exit Function
End If
End If

' 判断关键字是否有重复
For i = 1 To m_Count
If LCase(m_KeyArray(i)) = LCase(Item_Key) Then
Add = Null
Err.Raise 222, "CollCls:第62行", "新元素的关键字与原有关键字冲突。"
Exit Function
End If
Next

' 添加到数组中
m_Count = m_Count + 1

ReDim Preserve m_ItemArray(m_Count)
ReDim Preserve m_KeyArray(m_Count)

m_KeyArray(m_Count) = Item_Key

If IsObject(Item_Value) = True Then
Set m_ItemArray(m_Count) = Item_Value
Set Add = Item_Value
Else
m_ItemArray(m_Count) = Item_Value
Add = Item_Value
End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Clear() Method
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Clear()
Call Class_Initialize()
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Count() Method
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Count()
Count = m_Count
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Remove() Method
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Remove(Key_Index)
Dim i, j

' 方式(按关键字Key[字符串]; 按索引Index[整数])
Select Case VarType(Key_Index)
Case 8 ' 字符串 By Key
For i = 1 To m_Count
If LCase(Key_Index) = LCase(m_KeyArray(i)) Then
For j = i To m_Count - 1
m_KeyArray(j) = m_KeyArray(j + 1)
m_ItemArray(j) = m_ItemArray(j + 1)
Next

m_Count = m_Count - 1

ReDim Preserve m_KeyArray(m_Count)
ReDim Preserve m_ItemArray(m_Count)

Exit Sub
End If
Next
Case 2 ' 整数 By Index
i = Key_Index

If i > 0 And i < m_Count + 1 Then
For j = i To m_Count - 1
m_KeyArray(j) = m_KeyArray(j + 1)
m_ItemArray(j) = m_ItemArray(j + 1)
Next

m_Count = m_Count - 1

ReDim Preserve m_KeyArray(m_Count)
ReDim Preserve m_ItemArray(m_Count)

Exit Sub
End If
End Select

Err.Raise 333, "CollCls:第140行", "删除元素未成功，请检查指定的索引或关键字是否正确。"
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Item() Method
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Item(Key_Index)
Dim i

'方式(按关键字Key[字符串]; 按索引Index[整数])
Select Case VarType(Key_Index)
Case 8 ' By Key
For i = 1 To m_Count
If LCase(Key_Index) = LCase(m_KeyArray(i)) Then
If IsObject(m_ItemArray(i)) = True Then
Set Item = m_ItemArray(i)
Else
Item = m_ItemArray(i)
End If

Exit Function
End If
Next
Case 2 ' By Index
i = Key_Index

If i > 0 And i < m_Count + 1 Then
If IsObject(m_ItemArray(i)) = True Then
Set Item = m_ItemArray(i)
Else
Item = m_ItemArray(i)
End If

Exit Function
End If
End Select

Item = Null
Err.Raise 444, "CollCls:第178行", "元素未找到，请检查指定的索引或关键字是否正确。"
End Function
End Class

4 个解决方案