Last active
November 5, 2023 03:13
-
-
Save JavaScriptDude/c1d9302932293aac9b40857639de1540 to your computer and use it in GitHub Desktop.
Iterators for Visual Basic Collection Class
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
' 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment