In the project that i am working, there is a interop between Com and .Net where the Com Functions Expect Recordsets And They also provide Recordsets back to the .Net.

Using System.Xml namespace and some schema parsing code i am able to convert between DataSet Generated Xml Files And Recordset Generated using .Net without any need of reference to the ADO Com Libraries.

First Part Is DataSet To Recordset:

Option Strict Off

#Region "Imported Libraries"

Imports System.IO

Imports System.Xml

Imports System.Text

#End Region

Namespace AdoClassic

''' <summary>

''' This class converts a .NET DataSet to an ADODB Recordset.

''' Converts The Provided ADO.Net DataSet or Datatable Structures Into The ADO 2.5 Versions Recordset Objects Xml Based Representation using Schema Transformation And Dataset Xml Conversion.

''' Generally used for the transformation and data providing to the CSF.Reporting layer, so other Office Applications can use the Data Created By The CSF.

''' </summary>

''' <remarks></remarks>

Public NotInheritable Class AdoNetAdoClassicTools

Private Const MICROSOFTSCHEMAROWSET As String = "urn:schemas-microsoft-com:rowset"

''' <summary>

''' Initializes a new instance of the <see cref="T:ADONETToADOClassic" /> class.

''' </summary>

Private Sub New()

End Sub

''' <summary>

''' Converts The Given Recordset Xml File To DataSet

''' </summary>

''' <param name="fileName"></param>

''' <returns></returns>

''' <remarks></remarks>

Public Shared Function ConvertRecordsetXmlToDataSet(ByVal fileName As String) As DataSet

Return ConvertRecordsetXmlToDataSet(New FileStream(fileName, FileMode.Open))

End Function

''' <summary>

''' Converts The Given Recordset Xml File To DataSet

''' </summary>

''' <param name="recordsetXml"></param>

''' <returns></returns>

''' <remarks></remarks>

Public Shared Function ConvertRecordsetXmlToDataSet(ByVal recordsetXml As Stream) As DataSet

Dim tempDocument As XmlDocument = New XmlDocument()

tempDocument.Load(recordsetXml)

recordsetXml.Close()

Return ParseOutSchemaInformation(tempDocument)

End Function

Private Shared Function ParseOutSchemaInformation(ByVal document As Xml.XmlDocument) As DataSet

'<s:AttributeType name="DelDate" rs:number="52" rs:nullable="true" rs:write="true">

' <s:datatype dt:type="string" dt:maxLength="20" rs:precision="0" rs:maybenull="false"/>

'</s:AttributeType>

Dim resultDataTable As New DataTable

With document

Dim nodeList As XmlNodeList = .GetElementsByTagName("AttributeType", "uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882")

For Each rsNode As XmlNode In nodeList

Dim fieldName As String = rsNode.Attributes("name").Value

Dim fieldType As String = ""

Dim fieldMaxLength As Integer = 0

Dim declarationRow As XmlNode = rsNode.ChildNodes(0)

Dim attributes As XmlAttributeCollection = declarationRow.Attributes

For Each attribute As XmlAttribute In attributes

Select Case attribute.Name

Case "dt:type"

fieldType = ResolveDataType(attribute.Value)

End Select

Next

Dim tempColumn As New DataColumn(fieldName, System.Type.GetType(fieldType))

resultDataTable.Columns.Add(tempColumn)

Next

End With

Return ParseOutData(document, resultDataTable)

End Function

Private Shared Function ResolveDataType(ByVal typeName As String) As String

'TODO Additional Data Type Conversions Should Be Added Here

Select Case typeName

Case "string"

Return "System.String"

Case "int"

Return "System.Int32"

Case "float"

Return "System.Double"

Case "boolean"

Return "System.Boolean"

Case "uuid"

Return "System.Guid"

Case Else

Return "System.String"

End Select

End Function

Private Shared Function ParseOutData(ByVal document As Xml.XmlDocument, ByVal ds As DataTable) As DataSet

With document

Dim nodeList As XmlNodeList = .GetElementsByTagName("row", "#RowsetSchema")

For Each dataNode As XmlNode In nodeList

Dim dr As DataRow = ds.NewRow()

For Each attribute As XmlAttribute In dataNode.Attributes

attribute.Normalize()

dr(attribute.Name) = attribute.Value

Next

ds.Rows.Add(dr)

Next

End With

Dim resultDataset As New DataSet()

resultDataset.Tables.Add(ds)

Return resultDataset

End Function

''' <summary>

''' Takes a DataSet and converts into a Recordset. The converted

''' ADODB recordset is returned as a Recordset persisted XML string.

''' </summary>

''' <param name="DS">DataSet object</param>

''' <param name="dbName">DataTable Name</param>

''' <returns>String containing ADODB formatted XML</returns>

''' <remarks></remarks>

Public Shared Function ConvertDataSetToAdoRecordset(ByVal DS As DataSet, ByVal dbName As String) As String

Dim mStream As New MemoryStream

Try

'Create a MemoryStream to contain the XML

'Create an XmlWriter object, to write the formatted XML to the MemoryStream

Dim xWriter As New XmlTextWriter(mStream, Nothing)

'Additional formatting for XML

xWriter.Indentation = 8

xWriter.Formatting = Formatting.Indented

'call this Sub to write the ADONamespaces

WriteADONamespaces(xWriter)

'call this Sub to write the ADO Recordset Schema

WriteSchemaElement(DS, dbName, xWriter)

'Call this sub to transform the data portion of the Dataset

TransformData(DS, xWriter, dbName)

'Flush all input to XmlWriter

xWriter.Flush()

'Prepare the return value

mStream.Position = 0

Dim Buffer As Array

Buffer = Array.CreateInstance(GetType(Byte), mStream.Length)

mStream.Read(Buffer, 0, mStream.Length)

Dim TextConverter As New UTF8Encoding

Return TextConverter.GetString(Buffer)

Catch ex As Exception

Return ""

Finally

mStream.Close()

'mStream.Dispose()

End Try

End Function

''' <summary>

''' Add ADO XML namespaces to the XML output

''' </summary>

''' <param name="xWriter">The x writer.</param>

''' <remarks></remarks>

Private Shared Sub WriteADONamespaces(ByRef xWriter As XmlTextWriter)

'Use the following line to change the encoding if special characters are required

'writer.WriteProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")

With xWriter

'Add XML start element

.WriteStartElement("", "xml", "")

'Append the ADO Recordset namespaces

.WriteAttributeString("xmlns", "s", Nothing, "uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882")

.WriteAttributeString("xmlns", "dt", Nothing, "uuid:C2F41010-65B3-11d1-A29F-00AA00C14882")

.WriteAttributeString("xmlns", "rs", Nothing, MICROSOFTSCHEMAROWSET)

.WriteAttributeString("xmlns", "z", Nothing, "#RowsetSchema")

.Flush()

End With

End Sub

''' <summary>

''' Add Schema element to the XML output

''' </summary>

''' <param name="DS">The DS.</param>

''' <param name="dbName">Name of the db.</param>

''' <param name="xWriter">The x writer.</param>

''' <remarks></remarks>

Private Shared Sub WriteSchemaElement(ByVal DS As DataSet, ByVal dbName As String, ByRef xWriter As XmlTextWriter)

'write element Schema

With xWriter

.WriteStartElement("s", "Schema", "uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882")

.WriteAttributeString("id", "RowsetSchema")

'write element ElementType

.WriteStartElement("s", "ElementType", "uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882")

'write the attributes for ElementType

.WriteAttributeString("name", "", "row")

.WriteAttributeString("content", "", "eltOnly")

.WriteAttributeString("rs", "updatable", MICROSOFTSCHEMAROWSET, "true")

WriteSchema(DS, dbName, xWriter)

'write the end element for ElementType

.WriteFullEndElement()

'write the end element for Schema

.WriteFullEndElement()

.Flush()

End With

End Sub

''' <summary>

''' Add field definitions to the schema

''' </summary>

''' <param name="DS"></param>

''' <param name="dbName"></param>

''' <param name="xWriter"></param>

''' <remarks></remarks>

Private Shared Sub WriteSchema(ByVal DS As DataSet, ByVal dbName As String, ByRef xWriter As XmlTextWriter)

Dim i As Int32 = 1

Dim DC As DataColumn

For Each DC In DS.Tables(dbName).Columns

DC.ColumnMapping = MappingType.Attribute

With xWriter

.WriteStartElement("s", "AttributeType", "uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882")

.WriteAttributeString("name", "", DC.ToString)

.WriteAttributeString("rs", "number", MICROSOFTSCHEMAROWSET, i.ToString)

.WriteAttributeString("rs", "baseCatalog", MICROSOFTSCHEMAROWSET, dbName)

.WriteAttributeString("rs", "baseTable", MICROSOFTSCHEMAROWSET, DC.Table.TableName.ToString)

.WriteAttributeString("rs", "keycolumn", MICROSOFTSCHEMAROWSET, DC.Unique.ToString)

.WriteAttributeString("rs", "autoincrement", MICROSOFTSCHEMAROWSET, DC.AutoIncrement.ToString)

.WriteStartElement("s", "datatype", "uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882")

.WriteAttributeString("dt", "type", "uuid:C2F41010-65B3-11d1-A29F-00AA00C14882", GetDatatype(DC.DataType.ToString))

.WriteAttributeString("dt", "maxlength", "uuid:C2F41010-65B3-11d1-A29F-00AA00C14882", DC.MaxLength.ToString)

.WriteAttributeString("rs", "maybenull", MICROSOFTSCHEMAROWSET, DC.AllowDBNull.ToString)

'write end element for datatype

.WriteEndElement()

'end element for AttributeType

.WriteEndElement()

.Flush()

End With

i += 1

Next

DC = Nothing

End Sub

''' <summary>

''' Function to get the ADO compatible datatype

''' </summary>

''' <param name="DType"></param>

''' <returns></returns>

''' <remarks></remarks>

Private Shared Function GetDatatype(ByVal DType As String) As String

Select Case (DType)

Case "System.Int32", "System.Int16", "System.Integer"

Return "int"

Case "System.DateTime"

Return "dateTime.iso8601tz"

Case "System.String"

Return "string"

Case "System.Byte[]"

Return "bin.hex"

Case "System.Boolean"

Return "boolean"

Case "System.Guid"

Return "guid"

Case Else

Return "string"

End Select

End Function

''' <summary>

''' Transform the data format to ADO Recordset data format

''' This only transforms the data

''' </summary>

''' <param name="DS"></param>

''' <param name="xWriter"></param>

''' <remarks></remarks>

Private Shared Sub TransformData(ByVal DS As DataSet, ByRef xWriter As XmlTextWriter, ByVal tableName As String)

'Loop through DataSet and add data to XML

xWriter.WriteStartElement("", "rs:data", "")

Dim i As Long

Dim j As Integer

'For each row...

For i = 0 To DS.Tables(tableName).Rows.Count - 1

'Write the start element for the row

xWriter.WriteStartElement("", "z:row", "")

'For each field in the row...

For j = 0 To DS.Tables(tableName).Columns.Count - 1

'Write the attribute that describes this field and it's value

If DS.Tables(tableName).Columns(j).DataType.ToString = "System.Byte[]" Then

'Binary data must be properly encoded (bin.hex)

If Not IsDBNull(DS.Tables(tableName).Rows(i).Item(DS.Tables(tableName).Columns(j).ColumnName)) Then

xWriter.WriteAttributeString(DS.Tables(tableName).Columns(j).ColumnName, DataToBinHex(DS.Tables(tableName).Rows(i).Item(DS.Tables(tableName).Columns(j).ColumnName)))

End If

Else

If Not IsDBNull(DS.Tables(tableName).Rows(i).Item(DS.Tables(tableName).Columns(j).ColumnName)) Then

xWriter.WriteAttributeString(DS.Tables(tableName).Columns(j).ColumnName, CType(DS.Tables(tableName).Rows(i).Item(DS.Tables(tableName).Columns(j).ColumnName), String))

End If

End If

Next

'End the row element

xWriter.WriteEndElement()

Next

'Write the end element for rs:data

xWriter.WriteEndElement()

'Write the end element for xml

xWriter.WriteEndElement()

xWriter.Flush()

End Sub

''' <summary>

''' Helper function - encodes binary data to a bin.hex string

''' </summary>

''' <param name="thisData"></param>

''' <returns></returns>

''' <remarks></remarks>

Private Shared Function DataToBinHex(ByVal thisData As Byte()) As String

Dim sb As New StringBuilder

Dim i As Integer = 0

For i = 0 To thisData.Length - 1

'First nibble of byte (4 most significant bits)

sb.Append(Hex((thisData(i) And &HF0) / 2 ^ 4))

'Second nibble of byte (4 least significant bits)

sb.Append(Hex(thisData(i) And &HF))

Next

Return sb.ToString

End Function

End Class

End Namespace

The usage of the class is very simple:

Dim sampleDataSet as new DataSet()

Dim sampleDataTable as new DataTable()

sampleDataTable.TableName = "TestTable"

sampleDataTable.Columns.Add("TestColumn")

sampleDataSet.Tables.Add(sampleDataTable)

Dim adoxml as String = CSF.DAL.AdoClassic.AdoNetAdoClassicTools.ConvertDataSetToAdoRecordset(customerFactFileDataSet, dt.TableName)

just write out this adoxml to a file:

Dim file as new System.IO.FileStream("c:\result.xml",System.IO.FileMode.Create)

Dim writer as new System.IO.StreamWriter(file)

writer.Write(adoxml)

writer.Flush

writer.Close

And now the classic Vb 6.0 Part:

Private Function StringToRS(ByVal Value As String) As ADODB.Recordset
    On Error Resume Next
    Dim ADONETStream As New ADODB.Stream
    Dim RS As New ADODB.Recordset
    With ADONETStream
    .Open
    .WriteText (Value)
    .Position = 0
        RS.Open ADONETStream
    .Close
    End With
    Set ADONETStream = Nothing
    Set StringToRS = RS
End Function

Just Read The Above File As String

Set fs = CreateObject("Scripting.FileSystemObject")
Set file = fs.OpenTextFile("c:\test.txt", 1)
Dim resultString As String
resultString = file.ReadAll
file.Close
Dim resultset

set resultset = StringToRS(resultString)

Now you have a recordset that is generated from the DataSet without Com-Interop.

Part 2 of the series will have sample for converting from Recordset Generated Xml Files Directly To Datasets.

Happy Interoping