1

Тема: VBScript: эмуляция коллекции (имитация Scripting.Dictionary)

Иногда в коде требуется создать коллекцию без использования дополнительных компонентов (таких, как Scripting.Dictionary). Например, если Internet Explorer выдаёт сообщение о загрузке Activex. Предлагается класс для решения этой задачи:

'Класс коллекции

'Методы
'Add        Добавить элемент
'Remove        Удалить элемент
'RemoveAll    Удалить все элементы

''Свойства
'Item        Элемент по ключу
'Items        Коллекция элементов
'Key        Ключ по индексу
'Keys        Коллекция ключей
'Count        Количество элементов

'Функции
'Exists        Проверить существование элемента по ключу

'// Пример

Dim Collection
Set Collection = New clsCollection

Collection("элемент 1") = "тестовая строка"
Collection("элемент 2") = 12345
Set Collection("элемент 3") = CreateObject("Scripting.FileSystemObject")
Collection(3) = "1"
Collection(4) = Array("1","2","3")

Dim ret, Key, Item

For Each Key in Collection.Keys
    If IsObject(Collection(Key)) Then
        ret = ret & Key & "=" & TypeName(Collection(Key)) & " [Object]" & vbCrlf
    Else
        if isArray(Collection(Key)) Then
            ret = ret & Key & "=" & " [Array]" & vbCrlf
        Else
            ret = ret & Key & "=" & Collection(Key) & " [" & TypeName(Collection(Key)) & "]" & vbCrlf
        End if
    End if
    
Next

msgbox ret

'// Класс коллекции

Class clsCollection
    Private KeysArray, ItemsArray, ElementCount, ElementIndex, KeyIndex

    Private Sub Class_Initialize
        RemoveAll
    End Sub
        
    Public Default Property Get Item(ByVal Key)
        ElementIndex = GetKeyIndex(Key)
        if ElementIndex < 0 Then Exit Property 
        if IsObject(ItemsArray(ElementIndex)) Then
            Set Item = ItemsArray(ElementIndex)
        Else
            Item = ItemsArray(ElementIndex)
        End if
    End Property        

    Public Property Set Item(ByVal Key, Value)
        Item(Key) = Value
    End Property

    Public Property Let Item(ByVal Key, Value)
        ElementIndex = GetKeyIndex(Key)
        if ElementIndex => 0 Then 
            KeysArray(ElementIndex) = Key
            if IsObject(Value) Then
                Set ItemsArray(ElementIndex) = Value
            Else
                ItemsArray(ElementIndex) = Value
            End if
        Else
            Redim Preserve ItemsArray(ElementCount)
            Redim Preserve KeysArray(ElementCount)
            KeysArray(ElementCount) = Key
            if IsObject(Value) Then
                Set ItemsArray(ElementCount) = Value
            Else
                ItemsArray(ElementCount) = Value
            End if
            ElementCount = ElementCount + 1
        End if
    End Property
    
    Function Add(ByVal Key, Value)
        if GetKeyIndex(Key) => 0 Then
            Err.Raise vbObjectError + 1,,"Элемент уже существует в коллекции"
        Else
            Item(Key) = Value
        End if
    End Function
        
    Function Remove(ByVal Key)
        Dim KeyIndex
        KeyIndex = GetKeyIndex(Key)
        if KeyIndex < 0 Then Exit Function
        For ElementIndex = KeyIndex to ElementCount - 2
            ItemsArray(ElementIndex) = ItemsArray(ElementIndex+1)
            KeysArray(ElementIndex) = KeysArray(ElementIndex+1)
        Next
        Redim Preserve ItemsArray(ElementCount - 2)
        Redim Preserve KeysArray(ElementCount - 2)
        ElementCount = ElementCount - 1
    End Function        

    Public Property Get Key(ByVal Index)
        if Index <= Ubound(KeysArray) Then
            Key = KeysArray(Index)
        End if 
    End Property
        
    Private Function GetKeyIndex(ByVal Key)
        Key = LCase(Key)
        GetKeyIndex = -1
        For ElementIndex = 0 To ElementCount - 1
            if LCase(KeysArray(ElementIndex)) = Key Then
                GetKeyIndex = ElementIndex
                Exit For
            End if
        Next
    End Function
        
    Public Property Get Items
        Items = ItemsArray
    End Property

    Public Property Get Keys
        Keys = KeysArray
    End Property
        
    Function RemoveAll
        ItemsArray = Array()
        KeysArray = Array()
        ElementCount = 0
    End Function
        
    Function Exists(ByVal Key)
        if GetKeyIndex(Key) => 0 Then 
            Exists = True
        Else 
            Exists = False
        End if
    End Function
        
    Public Property Get Count
        Count = ElementCount
    End Property
End Class

Автор идеи - Xameleon.

Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.