Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports System.Reflection
Imports System.Reflection.Emit
Imports System.Text.RegularExpressions
Imports System.Runtime.CompilerServices
Namespace com.bodurov
Public Module DataSourceCreator
Private ReadOnly PropertNameRegex As New Regex("^[A-Za-z]+[A-Za-z0-9_]*$", RegexOptions.Singleline)
<Extension()> _
Public Function ToDataSource(ByVal list As IEnumerable(Of IDictionary)) As IEnumerable
Dim firstDict As IDictionary = Nothing
Dim hasData As Boolean = False
For Each currentDict As IDictionary In list
hasData = True
firstDict = currentDict
Exit For
Next
If Not hasData Then
Return New Object() {}
End If
If firstDict Is Nothing Then
Throw New ArgumentException("IDictionary entry cannot be null")
End If
Dim objectType As Type = Nothing
Dim tb As TypeBuilder = GetTypeBuilder(list.GetHashCode())
Dim constructor As ConstructorBuilder = tb.DefineDefaultConstructor(MethodAttributes.[Public] Or MethodAttributes.SpecialName Or MethodAttributes.RTSpecialName)
For Each pair As DictionaryEntry In firstDict
If PropertNameRegex.IsMatch(Convert.ToString(pair.Key), 0) Then
Dim type As Type
If pair.Value Is Nothing Then
type = GetType(Object)
Else
type = pair.Value.[GetType]()()
End If
CreateProperty(tb, Convert.ToString(pair.Key), type)
Else
Throw New ArgumentException("Each key of IDictionary must be alphanumeric and start with character.")
End If
Next
objectType = tb.CreateType()
Return GenerateEnumerable(objectType, list, firstDict)
End Function
Private Function GenerateEnumerable(ByVal objectType As Type, ByVal list As IEnumerable(Of IDictionary), ByVal firstDict As IDictionary) As IEnumerable
Dim listType As Type = GetType(List(Of )).MakeGenericType(New Type() {objectType})
Dim listOfCustom As IList = Activator.CreateInstance(listType)
For Each currentDict As IDictionary In list
If currentDict Is Nothing Then
Throw New ArgumentException("IDictionary entry cannot be null")
End If
Dim row As Object = Activator.CreateInstance(objectType)
For Each pair As DictionaryEntry In firstDict
If currentDict.Contains(pair.Key) Then
Dim [property] As PropertyInfo = objectType.GetProperty(Convert.ToString(pair.Key))
[property].SetValue(row, Convert.ChangeType(currentDict(pair.Key), [property].PropertyType, Nothing), Nothing)
End If
Next
listType.GetMethod("Add").Invoke(listOfCustom, New Object() {row})
Next
Return TryCast(listOfCustom, IEnumerable)
End Function
Private Function GetTypeBuilder(ByVal code As Integer) As TypeBuilder
Dim an As New AssemblyName("TempAssembly" & code.ToString())
Dim assemblyBuilder As AssemblyBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(an, AssemblyBuilderAccess.Run)
Dim moduleBuilder As ModuleBuilder = assemblyBuilder.DefineDynamicModule("MainModule")
Dim tb As TypeBuilder = moduleBuilder.DefineType("TempType" & code.ToString(), TypeAttributes.[Public] Or TypeAttributes.[Class] Or TypeAttributes.AutoClass Or TypeAttributes.AnsiClass Or TypeAttributes.BeforeFieldInit Or TypeAttributes.AutoLayout, GetType(Object))
Return tb
End Function
Private Sub CreateProperty(ByVal tb As TypeBuilder, ByVal propertyName As String, ByVal propertyType As Type)
Dim fieldBuilder As FieldBuilder = tb.DefineField("_" & propertyName, propertyType, FieldAttributes.[Private])
Dim propertyBuilder As PropertyBuilder = tb.DefineProperty(propertyName, PropertyAttributes.HasDefault, propertyType, Nothing)
Dim getPropMthdBldr As MethodBuilder = tb.DefineMethod("get_" & propertyName, MethodAttributes.[Public] Or MethodAttributes.SpecialName Or MethodAttributes.HideBySig, propertyType, Type.EmptyTypes)
Dim getIL As ILGenerator = getPropMthdBldr.GetILGenerator()
getIL.Emit(OpCodes.Ldarg_0)
getIL.Emit(OpCodes.Ldfld, fieldBuilder)
getIL.Emit(OpCodes.Ret)
Dim setPropMthdBldr As MethodBuilder = tb.DefineMethod("set_" & propertyName, MethodAttributes.[Public] Or MethodAttributes.SpecialName Or MethodAttributes.HideBySig, Nothing, New Type() {propertyType})
Dim setIL As ILGenerator = setPropMthdBldr.GetILGenerator()
setIL.Emit(OpCodes.Ldarg_0)
setIL.Emit(OpCodes.Ldarg_1)
setIL.Emit(OpCodes.Stfld, fieldBuilder)
setIL.Emit(OpCodes.Ret)
propertyBuilder.SetGetMethod(getPropMthdBldr)
propertyBuilder.SetSetMethod(setPropMthdBldr)
End Sub
End Module
End Namespace