<?xml version="1.0" encoding="utf-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
	<channel>
		<title><![CDATA[Серый форум &mdash; VBScript: эмуляция коллекции (имитация Scripting.Dictionary)]]></title>
		<link>https://forum.script-coding.com/viewtopic.php?id=2342</link>
		<atom:link href="https://forum.script-coding.com/extern.php?action=feed&amp;tid=2342&amp;type=rss" rel="self" type="application/rss+xml" />
		<description><![CDATA[Недавние сообщения в теме «VBScript: эмуляция коллекции (имитация Scripting.Dictionary)».]]></description>
		<lastBuildDate>Thu, 16 Oct 2008 10:22:03 +0000</lastBuildDate>
		<generator>PunBB</generator>
		<item>
			<title><![CDATA[VBScript: эмуляция коллекции (имитация Scripting.Dictionary)]]></title>
			<link>https://forum.script-coding.com/viewtopic.php?pid=14858#p14858</link>
			<description><![CDATA[<p>Иногда в коде требуется создать коллекцию без использования дополнительных компонентов (таких, как Scripting.Dictionary). Например, если Internet Explorer выдаёт сообщение о загрузке Activex. Предлагается класс для решения этой задачи:<br /></p><div class="codebox"><pre><code>&#039;Класс коллекции

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

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

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

&#039;// Пример

Dim Collection
Set Collection = New clsCollection

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

Dim ret, Key, Item

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

msgbox ret

&#039;// Класс коллекции

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 &lt; 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 =&gt; 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) =&gt; 0 Then
            Err.Raise vbObjectError + 1,,&quot;Элемент уже существует в коллекции&quot;
        Else
            Item(Key) = Value
        End if
    End Function
        
    Function Remove(ByVal Key)
        Dim KeyIndex
        KeyIndex = GetKeyIndex(Key)
        if KeyIndex &lt; 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 &lt;= 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) =&gt; 0 Then 
            Exists = True
        Else 
            Exists = False
        End if
    End Function
        
    Public Property Get Count
        Count = ElementCount
    End Property
End Class</code></pre></div><p>Автор идеи - <strong>Xameleon</strong>.</p>]]></description>
			<author><![CDATA[null@example.com (The gray Cardinal)]]></author>
			<pubDate>Thu, 16 Oct 2008 10:22:03 +0000</pubDate>
			<guid>https://forum.script-coding.com/viewtopic.php?pid=14858#p14858</guid>
		</item>
	</channel>
</rss>
