<% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''Function: ConvertRSToXML() ''Purpose: Converts a ADO recordset to XML ''Parameters: '' objRS: The ADO Recordset object '' strTopLevelNodeName: The descriptive name for the top-level node (E.g. customers) '' strRowNodeName: The descriptive name for the nodes (E.g. customer) ''Return: '' The XML string. '' ''Revisions: '' Date Developer Notes '' ? S. Mitchell Created '' 13-Jun-2001 D. O'Neill Updated to use cloning for improved performance '' 13-Dec-2001 D. O'Neill Updated to handle Nulls & simplified XML structure '' ''Notes: '' ''Technical Overview '' Procedures: '' 1. Itterate through links in page ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ConvertRsToXML3(objRS, strTopLevelNodeName, strRowNodeName) ' Put the recordset's fields' names into an array. Dim rs_fields Set rs_fields = objRs.Fields Dim field_count field_count = rs_fields.Count Dim max_index max_index = field_count - 1 Dim field_names Redim field_names(max_index) Dim field_index for field_index = 0 to max_index field_names(field_index) = rs_fields(field_index).Name next Set rs_fields = nothing ' Convert our Recordset to the multi-dimensional array. Dim aryRows aryRows = objRS.GetRows ' At this point we're done with the recordset. objRS.Close Set objRS = nothing ' Calculate the bounds of the rows array. Dim intNumFields, intNumRows intNumFields = UBound(aryRows) intNumRows = UBound(aryRows, 2) ' Instantiate the Microsoft XMLDOM. Dim objXMLDom Set objXMLDom = Server.CreateObject("Microsoft.XMLDOM") objXMLDom.preserveWhiteSpace = True ' Create the root element and append it to the XML document. Dim objXMLRoot Set objXMLRoot = objXMLDom.createElement(strTopLevelNodeName) objXMLDom.appendChild objXMLRoot ' Create the Row and Field elements Dim objXMLRow Set objXMLRow = objXMLDom.CreateElement(strRowNodeName) ' Build the template row by adding all the field names from the Recordset. Dim objXMLField for field_index = 0 to max_index Set objXMLField = objXMLDom.createElement(field_names(field_index)) objXMLRow.appendChild objXMLField ' Copy the field to give it a new memory address (copy all its children too) Set objXMLField = objXMLField.cloneNode(True) Next ' Deal with nulls. Dim intCurRowIdx, intCurFieldIdx For intCurRowIdx = 0 To intNumRows For intCurFieldIdx = 0 To intNumFields If IsNull(aryRows(intCurFieldIdx, intCurRowIdx)) Then aryRows(intCurFieldIdx, intCurRowIdx) = "" End If Next Next ' Create an array to hold the XML rows. Dim xml_rows_array Redim xml_rows_array(intNumRows) 'Iterate through the array of data and build the Rows For intCurRowIdx = 0 To intNumRows ' Store the row. Set xml_rows_array(intCurRowIdx) = objXMLRow ' Copy the current row to give it a new memory address (copy children too). Set objXMLRow = objXMLRow.CloneNode(True) Next ' Set the text on the fields. For intCurRowIdx = 0 To intNumRows Dim objXMLNodeList Set objXMLNodeList = xml_rows_array(intCurRowIdx).ChildNodes For intCurFieldIdx = 0 To intNumFields objXMLNodeList.Item(intCurFieldIdx).text = aryRows(intCurFieldIdx, intCurRowIdx) Next Next ' Append the rows to the root. For intCurRowIdx = 0 To intNumRows objXMLRoot.appendChild xml_rows_array(intCurRowIdx) next Dim objPI Set objPI = objXMLDom.createProcessingInstruction("xml", "version='1.0'") objXMLDom.insertBefore objPI, objXMLDom.childNodes(0) ' Set the output, allowing transformations Set ConvertRsToXML3 = objXMLDom End Function %>