Iterators for Visual Basic Collection Class

vb_collection_iterators.vb

' BEGIN VB Collection Hacks
' @copywright Timothy C. Quinn
' @license MIT
' Inspiration: https://stackoverflow.com/a/19497757/286807
' VB Collections don't have a public way to get the keys or have any iterators
' Below is a list of hacks that should be high performance and thread safe
' I doubt that the backend API of Visual Basic for Collections will change as its a really bad data structure to use
' However, this may possibly break in future versions of VB
' I tested up to VB 11
' WHEN IN DOUBT - DONT USE VB COLLECTIONS!!!
' AND BETTER YET!!!! DONT USE VB!!!!
 
Public Shared Iterator Function iter_items(of TKey)(col As Collection) As IEnumerable(Of KeyValuePair(Of TKey, Object))
    if col Is Nothing then throw New Exception("collection cannot be null")
    if col.count = 0 then return

    Dim ch = _get_vb_collection_hooks(col)

    Dim _list = ch.get_list.Invoke(col, Nothing)

    for i as Integer = 0 to col.Count - 1
        Dim _item = ch.get_item.GetValue(_list, {i})
        Dim oK as Object =  ch.get_item_key.GetValue(_item)
        if oK is Nothing then _
            throw New Exception("Key cannot be null")
        if Not oK.GetType.equals(GetType(TKey)) Then _
            throw New Exception($"Key must be a {GetType(TKey).FullName}. Got: {oK.GetType().FullName}")

        Yield New KeyValuePair(Of TKey, Object)(oK, ch.get_item_val.GetValue(_item))
    Next
End Function

Public Shared Iterator Function iter_keys(of T)(col as Collection) As IEnumerable(Of T)
    if col Is Nothing then throw New Exception("collection cannot be null")
    if col.count = 0 then return

    Dim ch = _get_vb_collection_hooks(col)
    Dim _list = ch.get_list.Invoke(col, Nothing)

    for i as Integer = 0 to col.Count - 1
        Dim _item = ch.get_item.GetValue(_list, {i})
        Dim oK as Object = ch.get_item_key.GetValue(_item)
        if oK is Nothing then _
            throw New Exception("Key cannot be null")

        if GetType(T).equals(GetType(Object)) then
            Yield oK
        End If

        if Not oK.GetType.equals(GetType(T)) Then _
            throw New Exception($"Key must be a {GetType(T).FullName} but got: {oK.GetType().FullName}")

        yield oK

    Next
End Function



Public Shared Iterator Function iter_vals(of T)(col as Collection, optional allow_null as Boolean = True) As IEnumerable(Of T)
    if col Is Nothing then throw New Exception("collection cannot be null")
    if col.count = 0 then return

    Dim ch = _get_vb_collection_hooks(col)
    Dim _list = ch.get_list.Invoke(col, Nothing)

    Dim _get_key = Function(itm as Object)
                        Dim oK as Object = ch.get_item_key.GetValue(itm)
                        if oK.GetType.equals(GetType(String)) then _
                            return CType(oK, String)
                        return $"{CStr(oK)} ({oK.GetType.FullName})"
                    End Function

    Dim _item as Object
    for i as Integer = 0 to col.Count - 1
        _item = ch.get_item.GetValue(_list, {i})
        Dim oV as Object = ch.get_item_val.GetValue(_item)
        if oV is Nothing then
            if not allow_null then
                throw New Exception($"Null value found in collection for key {_get_key(_item)}")
            end if
            yield Nothing
        End If

        if Not oV.GetType.equals(GetType(T)) Then _
            throw New Exception($"Value must be a {GetType(T).FullName} but got: {oV.GetType().FullName} for key {_get_key(_item)}")

        yield oV

    Next
End Function

Public Shared Function getKeys(col as Collection) as String()
    return iter_keys(of String)(col).toArray()
End Function

Public Shared Function getVals(of TVal)(col as Collection) as TVal()
    return iter_vals(of TVal)(col).toArray()
End Function


Private Shared __get_vb_collection_hooks_lock__ As New Object
Private Shared __get_col_list__ as MethodInfo
Private Shared __get_col_list_item__ as PropertyInfo
Private Shared __get_col_list_item_key__ as FieldInfo
Private Shared __get_col_list_item_val__ as FieldInfo

' This must get a non-empty collection
private Shared Function _get_vb_collection_hooks(col as Collection) _
    as (get_list as MethodInfo, 
        get_item as PropertyInfo, 
        get_item_key as FieldInfo, 
        get_item_val as FieldInfo)
    if col Is Nothing then throw New Exception("collection cannot be null")
    if col.Count = 0 then throw new Exception("collection cannot be empty")

    synclock __get_vb_collection_hooks_lock__
        if __get_col_list__ is Nothing then
            Dim flg As BindingFlags = BindingFlags.Instance Or BindingFlags.NonPublic
            __get_col_list__ = col.GetType.GetMethod("InternalItemsList", flg)

            Dim _list = __get_col_list__.Invoke(col, Nothing)
            __get_col_list_item__ = _list.GetType.GetProperty("Item", flg)

            Dim _item = __get_col_list_item__.GetValue(_list, {1})
            __get_col_list_item_key__ = _item.GetType.GetField("m_Key", flg)
            __get_col_list_item_val__ = _item.GetType.GetField("m_Value", flg)
        end if
    End SyncLock

    return (__get_col_list__, __get_col_list_item__, __get_col_list_item_key__, __get_col_list_item_val__)
End Function


' END VB Collection Hacks