From Rockford Lhotka's Expert C# 2008 and VB 2008 Business Objects books
In writing reports that get their data from a CSLA business object, the ObjectAdapter class will take in a CSLA object and return a DataSet of all String types that you can use to bind to the report.
The problem with this is you loose a lot of functionality in the report because all the types are Strings, so if you write formulas inside the report to do number or date math, you need to do a bunch of grungy type conversions to get the report formulas to work correctly.
To get around this problem, you need a DataSet that preserves the correct field types from the original CSLA object, so I developed an "ObjectAdapterTyped" class to handle this.
Would it be possible to shared this class and possibly have it added to the CSLA distribution?
Thank You.
Alex
I tried to add this class file as an attachment but the Forum says I do not have permission to do so. So here is the VB.Net code for the ObjectAdapterTyped.vb class file I have been using to create typed DataSets for report binding. It should go in the same folder as the ObjectAdapter.vb class file.
'#############################################################'## Project: Csla'## File: ObjectAdapterTyped'## Programmer: Alex Lancaster'## Description: This started out as a copy of the CSLA'## ObjectAdapter class, except it returns a typed ADO.Net '## DataSet instead of a DataSet with all String type columns.'## Not using a DataSet with properly typed columns will'## often cause problems down the line when binding the '## DataSet to a report writer object.'##'## The main difference between this class and the original'## is the mColumns ArrayList contains DataColumns now, not'## strings. Explicitly typed DataColumns are created'## in the AutoDiscover phase, and type conversions are'## performed in the DataCopy phase.'#############################################################
Imports System.ComponentModelImports System.Reflection
Namespace Data
Public Class ObjectAdapterTyped Private mColumns As New ArrayList Private NULL As DBNull
''' <summary> ''' Fills the DataSet with data from an object or collection. ''' </summary> ''' <remarks> ''' The name of the DataTable being filled is will be the class name of ''' the object acting as the data source. The ''' DataTable will be inserted if it doesn't already exist in the DataSet. ''' </remarks> ''' <param name="ds">A reference to the DataSet to be filled.</param> ''' <param name="source">A reference to the object or collection acting as a data source.</param> Public Sub Fill(ByRef ds As DataSet, ByVal Source As Object) Dim className As String className = TypeName(Source)
Fill(ds, className, Source) End Sub
''' <summary> ''' Fills the DataSet with data from an object or collection. ''' </summary> ''' <remarks> ''' The name of the DataTable being filled is specified as a parameter. The ''' DataTable will be inserted if it doesn't already exist in the DataSet. ''' </remarks> ''' <param name="ds">A reference to the DataSet to be filled.</param> ''' <param name="TableName"></param> ''' <param name="source">A reference to the object or collection acting as a data source.</param> Public Sub Fill(ByRef ds As DataSet, ByVal TableName As String, ByVal Source As Object) Dim dt As DataTable Dim exists As Boolean
dt = ds.Tables(TableName) exists = Not dt Is Nothing
If Not exists Then dt = New DataTable(TableName) End If
Fill(dt, Source)
If Not exists Then ds.Tables.Add(dt) End If End Sub
''' <summary> ''' Fills a DataTable with data values from an object or collection. ''' </summary> ''' <param name="dt">A reference to the DataTable to be filled.</param> ''' <param name="source">A reference to the object or collection acting as a data source.</param> Public Sub Fill(ByRef dt As DataTable, ByVal source As Object) AutoDiscover(source, True) DataCopy(dt, source) End Sub
#Region " Data Copy "
Private Sub DataCopy(ByRef dt As DataTable, ByVal Source As Object) If Source Is Nothing Then Exit Sub If mColumns.Count < 1 Then Exit Sub
If TypeOf Source Is IListSource Then DataCopyIList(dt, CType(Source, IListSource).GetList) ElseIf TypeOf Source Is IList Then DataCopyIList(dt, CType(Source, IList)) Else 'they gave us a regular object - create a list Dim col As New ArrayList col.Add(Source) DataCopyIList(dt, CType(col, IList)) End If
End Sub
Private Sub DataCopyIList(ByRef dt As DataTable, ByVal ds As IList) Dim index As Integer 'Dim column As String 'Dim item As String Dim dc As DataColumn Dim dr As DataRow
'Create columns if needed 'For Each column In mColumns ' If Not dt.Columns.Contains(column) Then ' dt.Columns.Add(column) ' End If 'Next For Each dc In mColumns If Not dt.Columns.Contains(dc.ColumnName) Then dt.Columns.Add(dc) End If Next
'load the data into the control dt.BeginLoadData() 'For index = 0 To ds.Count - 1 ' dr = dt.NewRow ' For Each column In mColumns ' Try ' dr(column) = GetField(ds(index), column)
' Catch ex As Exception ' dr(column) = ex.Message ' End Try ' Next ' dt.Rows.Add(dr) 'Next For index = 0 To ds.Count - 1 dr = dt.NewRow For Each dc In mColumns Try 'Depending on DataType, convert value into correct type Select Case dc.DataType.ToString Case "System.String", "System.GUID" 'To speed up execution, I put this Case here to catch most 'of the string/GUID values, and the default at the bottom is 'still a string type dr(dc.ColumnName) = ToString(GetColumn(ds(index), dc.ColumnName)) Case "System.Int32" 'item = CType(GetField(ds(index), dc.ColumnName), Int32).ToString 'dr(dc.ColumnName) = CType(GetField(ds(index), dc.ColumnName), Int32) dr(dc.ColumnName) = ToInteger(GetColumn(ds(index), dc.ColumnName)) Case "System.Int16" 'item = CType(GetField(ds(index), dc.ColumnName), Int16).ToString 'dr(dc.ColumnName) = CType(GetField(ds(index), dc.ColumnName), Int16) dr(dc.ColumnName) = ToShort(GetColumn(ds(index), dc.ColumnName)) Case "System.Int64" 'item = CType(GetField(ds(index), dc.ColumnName), Int64).ToString 'dr(dc.ColumnName) = CType(GetField(ds(index), dc.ColumnName), Int64) dr(dc.ColumnName) = ToLong(GetColumn(ds(index), dc.ColumnName)) Case "System.Decimal" 'item = CType(GetField(ds(index), dc.ColumnName), Decimal).ToString 'dr(dc.ColumnName) = CType(GetField(ds(index), dc.ColumnName), Decimal) dr(dc.ColumnName) = ToDecimal(GetColumn(ds(index), dc.ColumnName)) Case "System.DateTime", "Csla.SmartDate" 'item = CType(GetField(ds(index), dc.ColumnName), DateTime).ToString dr(dc.ColumnName) = ToDate(GetColumn(ds(index), dc.ColumnName)) Case "System.Boolean" 'item = CType(GetField(ds(index), dc.ColumnName), Boolean).ToString 'dr(dc.ColumnName) = CType(GetField(ds(index), dc.ColumnName), Boolean) dr(dc.ColumnName) = ToBoolean(GetColumn(ds(index), dc.ColumnName)) Case "System.Byte" dr(dc.ColumnName) = ToByte(GetColumn(ds(index), dc.ColumnName)) Case Else 'String is the default type 'item = GetField(ds(index), dc.ColumnName).ToString 'dr(dc.ColumnName) = GetField(ds(index), dc.ColumnName).ToString dr(dc.ColumnName) = ToString(GetColumn(ds(index), dc.ColumnName)) End Select
Catch ex As Exception 'dr(column) = ex.Message Throw New System.Data.DataException("Error loading data: " & dc.ColumnName, ex) End Try Next dt.Rows.Add(dr) Next dt.EndLoadData()
#End Region
#Region " AutoDiscover "
Private Sub AutoDiscover(ByVal Source As Object, Optional ByVal AllowDBNull As Boolean = True) Dim innerSource As Object
If TypeOf Source Is IListSource Then innerSource = CType(Source, IListSource).GetList Else innerSource = Source End If
mColumns.Clear()
If TypeOf innerSource Is DataView Then ScanDataView(CType(innerSource, DataView)) ElseIf TypeOf innerSource Is IList Then ScanIList(CType(innerSource, IList), AllowDBNull) Else 'they gave us a regular object ScanObject(innerSource, AllowDBNull) End If End Sub
Private Sub ScanDataView(ByVal ds As DataView) Dim field As Integer
For field = 0 To ds.Table.Columns.Count - 1 mColumns.Add(ds.Table.Columns(field)) Next End Sub
Private Sub ScanIList(ByVal ds As IList, Optional ByVal AllowDBNull As Boolean = True) Dim dc As DataColumn
If ds.Count > 0 Then 'retrieve the first item from the list Dim obj As Object = ds.Item(0)
If TypeOf obj Is ValueType AndAlso obj.GetType.IsPrimitive Then 'the value is a primitive value type 'mColumns.Add("Value") dc = CreateColumnFromValueType(CType(obj, ValueType), "Value", AllowDBNull) mColumns.Add(dc)
ElseIf TypeOf obj Is String Then 'the value is a simple string 'mColumns.Add("Text") dc = CreateColumnFromValueType(CType(obj, ValueType), "Text", AllowDBNull) mColumns.Add(dc)
Else 'we have a complex structure or object ScanObject(obj, AllowDBNull) End If End If
Private Sub ScanObject(ByVal Source As Object, Optional ByVal AllowDBNull As Boolean = True) Dim SourceType As Type = Source.GetType Dim column As Integer Dim dc As DataColumn
'retrieve a list of all public properties Dim props As PropertyInfo() = SourceType.GetProperties() If UBound(props) >= 0 Then For column = 0 To UBound(props) If props(column).CanRead Then 'Get property type dc = CreateColumnFromPropertyInfo(props(column), props(column).Name, AllowDBNull) 'mColumns.Add(props(column).Name) mColumns.Add(dc) End If Next End If
'retrieve a list of all public fields Dim fields As FieldInfo() = SourceType.GetFields() If UBound(fields) >= 0 Then For column = 0 To UBound(fields) 'Get field type dc = CreateColumnFromFieldInfo(fields(column), fields(column).Name, AllowDBNull) 'mColumns.Add(fields(column).Name) mColumns.Add(dc) Next End If End Sub
#Region " Create Column "
Private Function CreateColumnFromValueType( _ ByVal obj As ValueType, _ ByVal FieldName As String, _ Optional ByVal AllowDBNull As Boolean = True) As DataColumn
Dim dc As DataColumn
Try dc = New DataColumn(FieldName) dc.AllowDBNull = AllowDBNull Select Case obj.GetType.ToString Case "System.Boolean" With dc .DataType = System.Type.GetType("System.Boolean") .DefaultValue = False End With
Case "System.Int16" With dc .DataType = System.Type.GetType("System.Int16") .DefaultValue = 0 End With
Case "System.Int32" With dc .DataType = System.Type.GetType("System.Int32") .DefaultValue = 0 End With
Case "System.Int64" With dc .DataType = System.Type.GetType("System.Int64") .DefaultValue = 0 End With
Case "System.Decimal" With dc .DataType = System.Type.GetType("System.Decimal") .DefaultValue = 0 End With
Case "System.DateTime", "Csla.SmartDate" With dc .DataType = System.Type.GetType("System.DateTime") '.DefaultValue = Date.MinValue .DefaultValue = NULL End With
Case Else 'Default is String which is what the original ObjectAdapter was assigning all the time With dc .DataType = System.Type.GetType("System.String") .DefaultValue = String.Empty End With End Select
Return dc
Catch ex As Exception Throw New System.Data.DataException("Error reading value: " & FieldName, ex) End Try End Function
Private Function CreateColumnFromPropertyInfo( _ ByVal obj As PropertyInfo, _ ByVal FieldName As String, _ Optional ByVal AllowDBNull As Boolean = True) As DataColumn
Dim dc As DataColumn 'Dim sourcetype As Type
Try dc = New DataColumn(FieldName) dc.AllowDBNull = AllowDBNull 'sourcetype = obj.GetType
Select Case obj.PropertyType.FullName Case "System.Boolean" With dc .DataType = System.Type.GetType("System.Boolean") .DefaultValue = False End With
Private Function CreateColumnFromFieldInfo( _ ByVal obj As FieldInfo, _ ByVal FieldName As String, _ Optional ByVal AllowDBNull As Boolean = True) As DataColumn
Select Case obj.FieldType.FullName Case "System.Boolean" With dc .DataType = System.Type.GetType("System.Boolean") .DefaultValue = False End With
Case "System.Guid" With dc .DataType = System.Type.GetType("System.String") .DefaultValue = String.Empty End With
#Region " Get Field/Column "
'This function always returns a string, which causes some type conversion issues Private Function GetField(ByVal obj As Object, ByVal FieldName As String) As String If TypeOf obj Is DataRowView Then 'this is a DataRowView from a DataView Return CType(obj, DataRowView).Item(FieldName).ToString ElseIf TypeOf obj Is ValueType AndAlso obj.GetType.IsPrimitive Then 'this is a primitive value type Return obj.ToString ElseIf TypeOf obj Is String Then 'this is a simple string Return CStr(obj) Else 'this is a complex structure or object Try Dim sourcetype As Type = obj.GetType
'see if the field is a property Dim prop As PropertyInfo = sourcetype.GetProperty(FieldName)
If prop Is Nothing OrElse Not prop.CanRead Then 'no readable property of that name exists - check for a field Dim field As FieldInfo = sourcetype.GetField(FieldName)
If field Is Nothing Then 'no field exists either, throw an exception Throw New System.Data.DataException("No such value exists: " & FieldName) Else 'got a field, return its value If Not (field.GetValue(obj) Is Nothing) Then Return field.GetValue(obj).ToString Else Return String.Empty End If End If Else 'found a property, return its value If Not (prop.GetValue(obj, Nothing)) Is Nothing Then Return prop.GetValue(obj, Nothing).ToString Else Return String.Empty End If
End If
Catch ex As Exception Throw New System.Data.DataException("Error reading value: " & FieldName, ex) End Try End If End Function
'This function is used in combination with the Value Manipulation functions below Private Function GetColumn(ByVal obj As Object, ByVal FieldName As String) As Object If TypeOf obj Is DataRowView Then 'this is a DataRowView from a DataView Return CType(obj, DataRowView).Item(FieldName) ElseIf TypeOf obj Is ValueType AndAlso obj.GetType.IsPrimitive Then 'this is a primitive value type Return obj ElseIf TypeOf obj Is String Then 'this is a simple string Return obj Else 'this is a complex structure or object Try Dim sourcetype As Type = obj.GetType
If field Is Nothing Then 'no field exists either, throw an exception Throw New System.Data.DataException("No such value exists: " & FieldName) Else 'got a field, return its value Return field.GetValue(obj) End If Else 'found a property, return its value Return prop.GetValue(obj, Nothing) End If Catch ex As Exception Throw New System.Data.DataException("Error reading value: " & FieldName, ex) End Try End If End Function
#Region " Value Manipulation "
'Various methods for manipulating values and handling DBNull values. Private Overloads Function ToString(ByVal Value As Object) As String Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return String.Empty Else Return Value.ToString.Trim End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToInteger(ByVal Value As Object) As Integer Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return 0 Else Return CInt(Value) End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToShort(ByVal Value As Object) As Short Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return 0 Else Return CShort(Value) End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToDecimal(ByVal Value As Object) As Decimal Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return 0 Else Return CDec(Value) End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToLong(ByVal Value As Object) As Long Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return 0 Else Return CLng(Value) End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToSingle(ByVal Value As Object) As Single Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return 0 Else Return CSng(Value) End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToDouble(ByVal Value As Object) As Double Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return 0 Else Return CDbl(Value) End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToBoolean(ByVal Value As Object) As Boolean Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return False End If
If IsNumeric(Value) Then If CInt(Value) = 0 Then Return False Else Return True End If Else If Value.ToString.Trim = String.Empty Then Return False ElseIf UCase(Value.ToString.Trim) = "TRUE" Then Return True ElseIf UCase(Value.ToString.Trim) = "FALSE" Then Return False End If End If
Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToByte(ByVal Value As Object) As Byte Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return Convert.ToByte("") Else Return Convert.ToByte(Value) End If Catch ex As Exception Throw ex End Try End Function
Private Overloads Function ToDate(ByVal Value As Object) As Date Try If IsNothing(Value) OrElse IsDBNull(Value) Then Return Date.MinValue End If
If Value.ToString.Trim = String.Empty Then Return Date.MinValue ElseIf TypeOf Value Is SmartDate Then Return CDate(Value.ToString) ElseIf IsDate(Value) Then Return CDate(Value) Else Return Date.MinValue End If
'If TypeOf Value Is SmartDate Then ' Return CDate(Value.ToString) 'ElseIf Value.ToString.Trim = String.Empty Then ' Return Date.MinValue 'ElseIf IsDate(Value) Then ' Return CDate(Value) 'Else ' Return Date.MinValue 'End If
End Class
End Namespace
Why donate?