<%
Const mksHost = "http://localhost"
Sub GetData()
Dim oXMLHttp
Dim oXMLDoc
Dim sEnv
On Error Resume Next
' Create the SOAP envelope.
sEnv = ""
sEnv = sEnv & "<?xml version=""1.0"" encoding=""utf-8""?>"
sEnv = sEnv & "<SOAP:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' "
sEnv = sEnv & " xmlns:xsd='http://www.w3.org/2001/XMLSchema' "
sEnv = sEnv & " xmlns:SOAP='http://schemas.xmlsoap.org/soap/envelope/'> "
sEnv = sEnv & "<SOAP:Body>"
' In this section of the envelope, we'll set up the parameters and function that
' we want passed to the SOAP Server page. I've chosen these
' three records that I know will return valid records from the procedures.
sEnv = sEnv & ""
sEnv = sEnv & "<QRY_01_PRM_01>10248</QRY_01_PRM_01>"
sEnv = sEnv & "<QRY_02_PRM_01>10250</QRY_02_PRM_01>"
sEnv = sEnv & "<QRY_03_PRM_01>10260</QRY_03_PRM_01>"
sEnv = sEnv & "</m:GetContent></SOAP:Body></SOAP:Envelope>"
' Create the ServerXMLHttp object and settings for posting XML
Set oXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
oXMLHttp.Open "post", mksHost & "/webservices/SOAPServer.asp", False
oXMLHttp.setRequestHeader "Content-Type", "text/xml"
oXMLHttp.setRequestHeader "SOAPMethodName", mksHost & "/webservices:GetContentSend#GetContent"
' Actually send the SOAP message
oXMLHttp.send sEnv
If oXMLHttp.Status <> 200 Then
' We did not get a valid response from the http request.
Set oXMLHttp = nothing
Exit Sub
End if
' Create an XML Document object to load our XML stream returned
' in oXMLHttp.responsetext
Set oXMLDoc = Server.CreateObject("MSXML2.DOMDocument.3.0")
oXMLDoc.async = False
oXMLDoc.loadXML oXMLHttp.responseText
' I've built a standard SOAP error message into the XML in case of
' database errors. Here, we'll check to see if the error message
' exists. Your error handling is likely to be more involved than mine.
If SOAPError(oXMLDoc) <> 0 Then
' No SOAP errors found. Let's extract the XML from each recordset and send it
' to our ProcessNode function to load it back into an ADO Recordset.
ProcessNode Trim(oXMLDoc.selectSingleNode("SOAP:Envelope/SOAP:Body/m:GetContentResp//QRY_01").Text)
ProcessNode Trim(oXMLDoc.selectSingleNode("SOAP:Envelope/SOAP:Body/m:GetContentResp//QRY_02").Text)
ProcessNode Trim(oXMLDoc.selectSingleNode("SOAP:Envelope/SOAP:Body/m:GetContentResp//QRY_03").Text)
End if
Set oXMLHttp = Nothing
Set oXMLDoc = Nothing
End Sub
Sub ProcessNode(sXML)
Dim oADORec
Dim oXMLDoc
Dim oADOCol
On Error Resume Next
If Trim(sXML) = "" Then Exit Sub
' Create a disconnected ADO recordset and XML Document object.
Set oADORec = Server.CreateObject("ADODB.Recordset")
Set oXMLDoc = Server.CreateObject("MSXML2.DOMDocument.3.0")
oXMLDoc.loadXML sXML ' Load the XML stream
oADORec.Open oXMLDoc ' Load the XML Document into a recordset.
' The obvious, traverse the recordset and see what we've got.
While Not oADORec.EOF
For Each oADOCol In oADORec.Fields
response.write oADOCol.Name & " " & oADOCol.Value & "<br>"
Next
oADORec.MoveNext
Wend
Set oADORec = Nothing
Set oXMLDoc = Nothing
End Sub
Function SOAPError(oXMLDoc)
SOAPError = 1
If InStr(1, oXMLDoc.xml, "<faultcode>", 1) < 1 Then Exit Function
SOAPError = 0
With Response
.write oXMLDoc.selectSingleNode("SOAP:Envelope/SOAP:Body/SOAP:Fault//faultcode").Text & "<br>"
.write oXMLDoc.selectSingleNode("SOAP:Envelope/SOAP:Body/SOAP:Fault//faultstring").Text & "<br>"
.write oXMLDoc.selectSingleNode("SOAP:Envelope/SOAP:Body/SOAP:Fault/detail//message").Text & "<br>"
End With
End Function
Call GetData()
%>
|
<%
Const mksHost = "http://localhost"
Sub SendContent()
dim oXMLDoc
dim sQRY_01_PRM_01
dim sQRY_02_PRM_01
dim sQRY_03_PRM_01
dim sRetXML1
dim sRetXML2
dim sRetXML3
on error resume next
Response.ContentType="text/xml"
Set oXMLDoc = Server.CreateObject("Microsoft.XMLDOM")
oXMLDoc.load Request ' Load the incoming SOAP message.
' Retrieve input variables from the incoming SOAP message.
sQRY_01_PRM_01 = Trim(oXMLDoc.SelectSingleNode("SOAP:Envelope/SOAP:Body/m:GetContent/QRY_01_PRM_01").Text)
sQRY_02_PRM_01 = Trim(oXMLDoc.SelectSingleNode("SOAP:Envelope/SOAP:Body/m:GetContent/QRY_02_PRM_01").Text)
sQRY_03_PRM_01 = Trim(oXMLDoc.SelectSingleNode("SOAP:Envelope/SOAP:Body/m:GetContent/QRY_03_PRM_01").Text)
Set oXMLDoc = nothing
' Get our individual ADO recordset streams returned in the ByRef variables
' sRetXML1, sRetXML2, and sRetXML3
Call RetrieveData(sQRY_01_PRM_01,sQRY_02_PRM_01,sQRY_03_PRM_01,sRetXML1,sRetXML2,sRetXML3)
' We'll send the SOAP response back here using the Response object. Note that
' we surround each individual ADO recordset's XML string with the CDATA tag
' to prevent the valid XML strings from invalidating our overall SOAP XML message.
With Response
.write "<?xml version=""1.0"" encoding=""utf-8""?>"
.write "<SOAP:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' "
.write " xmlns:xsd='http://www.w3.org/2001/XMLSchema' "
.write " xmlns:SOAP='http://schemas.xmlsoap.org/soap/envelope/'> "
.write "<SOAP:Body>"
.write "<m:GetContentResp xmlns:m='" & mksHost & "/webservices/""'>"
.write "<QRY_01><![CDATA[" & sRetXML1 & "]]></QRY_01>"
.write "<QRY_02><![CDATA[" & sRetXML2 & "]]></QRY_02>"
.write "<QRY_03><![CDATA[" & sRetXML3 & "]]></QRY_03>"
.write "</m:GetContentResp>"
.write "</SOAP:Body>"
.write "</SOAP:Envelope>"
End with
end sub
Sub RetrieveData(sQRY_01_PRM_01,sQRY_02_PRM_01,sQRY_03_PRM_01,sRetXML1,sRetXML2,sRetXML3)
Dim oADOCon
Dim oADORec
Dim oADOCom
Dim oStream
Dim oRS
on error resume next
' As stated above in the article, you'll want to substitute this
' code with code that will create all three recordsets with one
' call to the database. Read the MSDN article, its quite simple.
' Each recordset is processed the same way. Use the Save
' method to output the recordset to a Stream object. Then,
' use the Stream object's ReadText method to convert the
' the stored XML into a simple string.
Set oADOCon = Server.CreateObject("ADODB.Connection")
Set oADORec = Server.CreateObject("ADODB.Recordset")
Set oStream =Server.CreateObject("ADODB.Stream")
oADOCon.CursorLocation = adUseClient
oADOCon.open "Provider=SQLOLEDB;Data Source=(local);User ID=sa;Password=;Initial Catalog=NORTHWIND"
oADORec.Open "CustOrdersDetail(" & sQRY_01_PRM_01 & ")", oADOCon ,adOpenStatic, adLockReadOnly,adCmdStoredProc
if err.number = 0 then
oADORec.Save oStream, adPersistXML
sRetXML1 = oStream.ReadText(adReadAll)
else
Call WriteSOAPError(err.number,err.description)
If oADORec.STATE = adStateOpen Then oADORec.Close
If oADOCon.STATE = adStateOpen Then oADOCon.Close
Set oADORec = Nothing
Set oADOCon = Nothing
Exit Sub
end if
If oADORec.STATE = adStateOpen Then oADORec.Close
oADORec.Open "CustOrdersDetail(" & sQRY_02_PRM_01 & ")", oADOCon ,adOpenStatic, adLockReadOnly,adCmdStoredProc
if err.number = 0 then
oADORec.Save oStream, adPersistXML
sRetXML2 = oStream.ReadText(adReadAll)
else
Call WriteSOAPError(err.number,err.description)
If oADORec.STATE = adStateOpen Then oADORec.Close
If oADOCon.STATE = adStateOpen Then oADOCon.Close
Set oADORec = Nothing
Set oADOCon = Nothing
Exit Sub
end if
If oADORec.STATE = adStateOpen Then oADORec.Close
oADORec.Open "CustOrdersDetail(" & sQRY_03_PRM_01 & ")", oADOCon ,adOpenStatic, adLockReadOnly,adCmdStoredProc
if err.number = 0 then
oADORec.Save oStream, adPersistXML
sRetXML3 = oStream.ReadText(adReadAll)
else
Call WriteSOAPError(err.number,err.description)
If oADORec.STATE = adStateOpen Then oADORec.Close
If oADOCon.STATE = adStateOpen Then oADOCon.Close
Set oADORec = Nothing
Set oADOCon = Nothing
Exit Sub
end if
If oADORec.STATE = adStateOpen Then oADORec.Close
If oADOCon.STATE = adStateOpen Then oADOCon.Close
Set oADORec = Nothing
Set oADOCon = Nothing
End Sub
Sub WriteSOAPError(sErrCode,sErrMsg)
' You may want to enhance this error handler. It is SOAP compliant
' but you'll likely want to add additional nodes for more detail.
With Response
.write "<?xml version=""1.0"" encoding=""utf-8""?>"
.write "<SOAP:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/2001/XMLSchema' "
.write " xmlns:SOAP='http://schemas.xmlsoap.org/soap/envelope/'> "
.write "<SOAP:Body>"
.write " <SOAP:Fault>" & vbcrlf
.write " <faultcode>SOAP:Client.AppError</faultcode>" & vbcrlf
.write " <faultstring>Application Error</faultstring>" & vbcrlf
.write " <detail>" & vbCRlf
.write " <message>" & sErrMsg & "</message>" & vbCrLf
.write " <errorcode>" & sErrCode & "</errorcode>" & vbCrLf
.write "</detail>" & vbCRLF
.write "</SOAP:Fault>" & vbcrlf
.write "</SOAP:Body>" & vbcrlf
.write "</SOAP:Envelope>" & vbcrlf
End with
End Sub
Call SendContent()
%>
|