1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
| function folderpath()
Dim fs,f
Set fs = Server.CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(request.ServerVariables("PATH_TRANSLATED"))
folderpath = replace(request.ServerVariables("PATH_TRANSLATED"), f.name,"")
set f = nothing
set fs = nothing
end function
Function ConvertRStoXML(objRS, strTopLevelNodeName, strRowNodeName) '(Recordset, ChaineDeCaracteres, ChaineDeCaracteres)
on error resume next
Dim objDom
Dim objRoot
Dim objField
Dim objFieldValue
Dim objcolName
Dim objattTabOrder
Dim objPI
Dim x
Dim objRSField
Dim objRow
Dim filename
objRS.movefirst
'Instantiate the Microsoft XMLDOM.
Set objDom = server.CreateObject("Microsoft.XMLDOM")
objDom.preserveWhiteSpace = True
'Create your root element and append it to the XML document.
Set objRoot = objDom.createElement(strTopLevelNodeName)
objDom.appendChild objRoot
Do While Not objRS.EOF
Set objRow = objDom.CreateElement(strRowNodeName)
For Each objRSField in objRS.Fields
Set objField = objDom.createElement(objRSField.Name)
objField.Text = objRSField.Value
objField.appendChild objFieldValue
objRow.appendChild objField
Next
objRoot.appendChild objRow
objRS.MoveNext
Loop
Set objPI = objDom.createProcessingInstruction("xml-stylesheet", "type='text/xsl' href='http://monsite/mapage.xsl'")
'objDom.insertBefore objPI, objDom.childNodes(0)
Set objPI = objDom.createProcessingInstruction("xml", "version='1.0' encoding='iso-8859-1'")
objDom.insertBefore objPI, objDom.childNodes(0)
filename = strTopLevelNodeName & strRowNodeName & ".xml"
objDom.Save folderpath() & filename
ConvertRStoXML = filename
'Clean up...
Set filename = nothing
Set objDom = Nothing
Set objRoot = Nothing
Set objField = Nothing
Set objFieldValue = Nothing
Set objcolName = Nothing
Set objattTabOrder = Nothing
Set objPI = Nothing
End Function |