1 (изменено: dsb, 2009-11-22 13:50:13)

Тема: VBScript: двухуровневый Dictionary

Часто возможностей стандартного объекта Dictionary не хватает из-за того, что он одноуровневый. Поскольку в качестве item данного объекта может быть любой иной объект, то напрашивается там хранить другой словарь, тем самым реализуя двух и более уровневые словари. Привожу пример кода для 2-х уровневого варианта:

Set objRootDict = CreateObject("Scripting.Dictionary")

arrTest = Array(10,20,30) ' в качестве полезной нагрузке будем хранить, например, массив
Add_Element "A", "1", arrTest ' добавляем элемент в коллекцию
arrTest = Array(40,50,60)
Add_Element "A", "2", arrTest
arrTest = Array(70,80,90)
Add_Element "B", "1", arrTest
WScript.Echo Get_Element("B", "1")(2) ' получаем элемент из коллекции

' Перебор всей коллекции и вывод на экран
For Each dbgMainKey In objRootDict.Keys
    Set objTempDict = objRootDict.Item(dbgMainKey)
    For Each dbgKey In objTempDict.Keys
        arrValueList = objTempDict.Item(dbgKey)
        s = dbgMainKey & vbTab & dbgKey
        For i = 0 To UBound(arrValueList)
            s = s & vbTab & CStr(arrValueList(i))
        Next
        WScript.Echo s
    Next
Next

Sub Add_Element(parLevel_1, parVevel_2, parValue)
    If Not objRootDict.Exists(parLevel_1) Then
        Set objTempDict = CreateObject("Scripting.Dictionary")
        objRootDict.Add parLevel_1, objTempDict
    Else
        Set objTempDict = objRootDict.Item(parLevel_1)
    End If
    objTempDict.Add parVevel_2, parValue
End Sub
    
Function Get_Element(parLevel_1, parVevel_2)
    If objRootDict.Exists(parLevel_1) Then
        Set objTempDict = objRootDict.Item(parLevel_1)
        If objTempDict.Exists(parVevel_2) Then 
            Get_Element = objTempDict.Item(parVevel_2)
        Else
            Get_Element = Null
        End If
    else
        Get_Element = Null
    End If
End Function