Pathetic Plea for help
A number of people have asked me for a VB version of the CopyToDataTable<T> sample I wrote a few months back. Unfortunately, between getting some skiing in (lots of snow in Washington this year!) and getting Astoria ready for Mix, I have not had very little free time. Hence, if anyone else wants to take a crack at this - or knows of an existing port of the code to VB, let me know.
Comments
- Anonymous
January 11, 2008
PingBack from http://msdn.blogsforu.com/msdn/?p=4718 - Anonymous
January 13, 2008
Imports Microsoft.VisualBasicImports SystemImports System.Collections.GenericImports System.LinqImports System.TextImports System.DataImports System.ReflectionNamespace WindowsFormsApplication1
Dim table1 As DataTable = query1.CopyToDataTable() ' load into existing DataTable - schemas matchFriend Class Sample Shared Sub Main(ByVal args() As String) ' create sequence Dim items() As Item = New Item() { New Book With {.Id = 1, .Price = 13.50, .Genre = "Comedy", .Author = "Jim Bob"}, New Book With {.Id = 2, .Price = 8.50, .Genre = "Drama", .Author = "John Fox"}, New Movie With {.Id = 1, .Price = 22.99, .Genre = "Comedy", .Director = "Phil Funk"}, New Movie With {.Id = 1, .Price = 13.40, .Genre = "Action", .Director = "Eddie Jones"}} Dim query1 = From i In items _ Where i.Price > 9.99 _ Order By i.Price _ Select i ' load into new DataTable
Public Module DataSetLinqOperators <System.Runtime.CompilerServices.Extension()> _ Public Function CopyToDataTable(Of T)(ByVal source As IEnumerable(Of T)) As DataTable Return New ObjectShredder(Of T)().Shred(source, Nothing, Nothing) End Function <System.Runtime.CompilerServices.Extension()> _ Public Function CopyToDataTable(Of T)(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As Nullable(Of LoadOption)) As DataTable Return New ObjectShredder(Of T)().Shred(source, table, options) End Function End Module Public Class ObjectShredder(Of T) Private _fi() As FieldInfo Private _pi() As PropertyInfo Private _ordinalMap As Dictionary(Of String, Integer) Private _type As Type Public Sub New() _type = GetType(T) _fi = _type.GetFields() _pi = _type.GetProperties() _ordinalMap = New Dictionary(Of String, Integer)() End Sub Public Function Shred(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As Nullable(Of LoadOption)) As DataTable If GetType(T).IsPrimitive Then Return ShredPrimitive(source, table, options) End If If table Is Nothing Then table = New DataTable(GetType(T).Name) End If ' now see if need to extend datatable base on the type T + build ordinal map table = ExtendTable(table, GetType(T)) table.BeginLoadData() Using e As IEnumerator(Of T) = source.GetEnumerator() Do While e.MoveNext() If options.HasValue Then table.LoadDataRow(ShredObject(table, e.Current), CType(options, LoadOption)) Else table.LoadDataRow(ShredObject(table, e.Current), True) End If Loop End Using table.EndLoadData() Return table End Function Public Function ShredPrimitive(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As Nullable(Of LoadOption)) As DataTable If table Is Nothing Then table = New DataTable(GetType(T).Name) End If If (Not table.Columns.Contains("Value")) Then table.Columns.Add("Value", GetType(T)) End If table.BeginLoadData() Using e As IEnumerator(Of T) = source.GetEnumerator() Dim values() As Object = New Object(table.Columns.Count - 1) {} Do While e.MoveNext() values(table.Columns("Value").Ordinal) = e.Current If options.HasValue Then table.LoadDataRow(values, CType(options, LoadOption)) Else table.LoadDataRow(values, True) End If Loop End Using table.EndLoadData() Return table End Function Public Function ExtendTable(ByVal table As DataTable, ByVal type As Type) As DataTable ' value is type derived from T, may need to extend table. For Each f As FieldInfo In type.GetFields() If (Not _ordinalMap.ContainsKey(f.Name)) Then Dim dc As DataColumn dc = If(table.Columns.Contains(f.Name), table.Columns(f.Name), table.Columns.Add(f.Name, f.FieldType)) _ordinalMap.Add(f.Name, dc.Ordinal) End If Next f For Each p As PropertyInfo In type.GetProperties() If (Not _ordinalMap.ContainsKey(p.Name)) Then Dim dc As DataColumn dc = If(table.Columns.Contains(p.Name), table.Columns(p.Name), table.Columns.Add(p.Name, p.PropertyType)) _ordinalMap.Add(p.Name, dc.Ordinal) End If Next p Return table End Function Public Function ShredObject(ByVal table As DataTable, ByVal instance As T) As Object() Dim fi() As FieldInfo = _fi Dim pi() As PropertyInfo = _pi If instance.GetType() IsNot GetType(T) Then ExtendTable(table, instance.GetType()) fi = instance.GetType().GetFields() pi = instance.GetType().GetProperties() End If Dim values() As Object = New Object(table.Columns.Count - 1) {} For Each f As FieldInfo In fi values(_ordinalMap(f.Name)) = f.GetValue(instance) Next f For Each p As PropertyInfo In pi values(_ordinalMap(p.Name)) = p.GetValue(instance, Nothing) Next p Return values End Function End ClassEnd NamespaceDim table2 As DataTable = New DataTable() table2.Columns.Add("Price", GetType(Integer)) table2.Columns.Add("Genre", GetType(String)) Dim query2 = From i In items _ Where i.Price > 9.99 _ Order By i.Price _ Select New With { i.Price, i.Genre } query2.CopyToDataTable(table2, LoadOption.PreserveChanges) ' load into existing DataTable - expand schema + autogenerate new Id. Dim table3 As DataTable = New DataTable() Dim dc As DataColumn = table3.Columns.Add("NewId", GetType(Integer)) dc.AutoIncrement = True table3.Columns.Add("ExtraColumn", GetType(String)) Dim query3 = From i In items _ Where i.Price > 9.99 _ Order By i.Price _ Select New With { i.Price, i.Genre } query3.CopyToDataTable(table3, LoadOption.PreserveChanges) ' load sequence of scalars. Dim query4 = From i In items _ Where i.Price > 9.99 _ Order By i.Price _ Select i.Price Dim DataTable4 = query4.CopyToDataTable() End Sub Public Class Item Private privateId As Integer Public Property Id() As Integer Get Return privateId End Get Set(ByVal value As Integer) privateId = value End Set End Property Private privatePrice As Double Public Property Price() As Double Get Return privatePrice End Get Set(ByVal value As Double) privatePrice = value End Set End Property Private privateGenre As String Public Property Genre() As String Get Return privateGenre End Get Set(ByVal value As String) privateGenre = value End Set End Property End Class Public Class Book Inherits Item Private privateAuthor As String Public Property Author() As String Get Return privateAuthor End Get Set(ByVal value As String) privateAuthor = value End Set End Property End Class Public Class Movie Inherits Item Private privateDirector As String Public Property Director() As String Get Return privateDirector End Get Set(ByVal value As String) privateDirector = value End Set End Property End ClassEnd Class
- Anonymous
January 14, 2008
We have a VB version of this source code in the samples' source code of the LINQ in Action book (http://LinqInAction.net).Here is the complete archive: http://linqinaction.net/files/folders/linqinaction/entry1952.aspxSee the files DataSetLinqOperators.vb and ObjectShreder.vb in Chapter14.VBChapter14.Note: In our version, we kept the original names of the query operators for clarity (ToDataTable and LoadSequence). - Anonymous
January 20, 2008
The comment has been removed - Anonymous
January 20, 2008
VB implementation to handle nullable types as well :Public Function ExtendTable(ByVal table As DataTable, ByVal type As Type) As DataTable For Each f As FieldInfo In type.GetFields() If (Not _ordinalMap.ContainsKey(f.Name)) Then Dim dc As DataColumn dc = If(table.Columns.Contains(f.Name), table.Columns(f.Name), table.Columns.Add(f.Name, f.FieldType)) _ordinalMap.Add(f.Name, dc.Ordinal) End If Next f For Each p As PropertyInfo In type.GetProperties() If Not _ordinalMap.ContainsKey(p.Name) Then Dim colType As Type = p.PropertyType If (colType.IsGenericType) AndAlso (colType.GetGenericTypeDefinition() Is GetType(Nullable(Of ))) Then colType = colType.GetGenericArguments()(0) End If Dim dc As DataColumn = IIf(table.Columns.Contains(p.Name), table.Columns(p.Name), table.Columns.Add(p.Name, colType)) _ordinalMap.Add(p.Name, dc.Ordinal) End If Next Return tableEnd Function - Anonymous
February 15, 2008
a small problem guys...this function does not set the primarykey on the datatable.which is needed in case you wish to update the table using an sqlcommand.has anyone been able to get this to work? - Anonymous
October 15, 2008
IntheoriginalLinqCTPandthefirstOrcasBeta,weincludedaDataSetspecificLinqoperatorcall...