'SQL To ADO XML for HomeSite 4.5.1
'Author: Corey Haines (corey@elender.hu)
'Description: 	This script takes a connection string and a sql statement and returns the ADO-generated XML
'file in a new document.
'Updates:
'
' This script has been released to the public domain. If you make a change, please let me know, so I can add it,
' if necessary, to the original. You are free to distribute this script, as long as you leave this header in place.
'
option explicit

const c_ConnStr = "" ' You can put a default connection string here

sub Main()
	dim oRS
	dim sSQL, sConnStr
	dim sXML
	
	sConnStr = c_ConnStr
	
	if len(trim(sConnStr)) = 0 then
		sConnStr = InputBox("Please enter connection str")
	end if
	if len(trim(sSQL)) = 0 then
		sSQL = InputBox("Please enter sql")
	end if
	if len(trim(sConnStr)) > 0 and len(trim(sSQL)) > 0 then
		set oRS = getRecordSet(sSQL, sConnStr)
		sXML = RecordSetToXML(oRS)
		oRS.close
		set oRS = Nothing
		WriteToNewDocument sXML
		sXML = ""
	end if
end sub

sub WriteToNewDocument(sToWrite)
	application.newdocument false
	application.activedocument.text = sToWrite
end sub

function RecordSetToXML(oRS)
	dim stmXML, sXML
	
	set stmXML = CreateObject("ADODB.Stream")
	oRS.save stmXML, 1
	sXML = stmXML.readtext(-1)
	RecordSetToXML = sXML
end function

function getRecordSet(sSQL, sConnStr)
	dim oRS
	
	set oRS = CreateObject("ADODB.Recordset")
	oRS.CursorLocation = 2 ' adUseClient
	oRS.LockType = 4 ' adBatchOptimistic
	oRS.ActiveConnection = sConnStr
	oRS.open sSQL

	set getRecordSet = oRS

	set oRS = nothing
end function