SOAP Call Using ASP/VBScript

UPDATE 10/14/2005 11:07am
Found one more little bug. An extraneous slash at the end of the namespace in some cases, and so the correction has been reflected in the source listing below..

UPDATE 10/13/2005 1:07pm
I corrected a slight bug in the code. The line that used to read
redim parms ( i ) 
now reads
redim preserve parms ( i ) 

Some time back, I posted an entry about calling a web service method using HttpWebRequest. I have translated that code into ASP/VBScript and have posted it here. Some stuff I have been working on required it to be done this way, and I thought that someone else might find it beneficial. The main reason for needing to do this in my case was that the server was upgraded to Windows 2003 Server from Windows 2000 Server, and it broke the SOAP API toolkit.


function makeWebMethodRequest ( url, webMethod, parmValues )
    dim xmlHttp
    dim ns
    dim ns1
    dim xml
    dim xmlDoc
    dim attrs
    dim attr
    dim nodes
    dim node
    dim cNode
    dim sNode
    dim pNode
    dim parms ( )
    dim i
    dim returnsResult
    dim soapXml
    dim p
    dim v
    dim soapDoc
    dim responseXml
    dim xmlSend
    dim soapAction
    dim webMethodResult

    if ( Right ( url, 5 ) <> "?wsdl" ) Then
        url = url & "?wsdl"
    end If

    set xmlHttp = server.CreateObject ( "Msxml2.ServerXMLHTTP" )
    xmlHttp.open "GET", url, false
    xmlHttp.send vbNull
    xml = xmlHttp.responseText

    set xmlDoc = server.CreateObject ( "Microsoft.XMLDOM" )
    xmlDoc.loadXML ( xml )

    set attrs = xmlDoc.getElementsByTagName ( "wsdl:definitions" ) .item ( 0 ) .attributes
    ns = getAttribute ( "targetNamespace", attrs ) .text
    ns1 = ns
    if right ( ns, 1 ) <> "/" then
        ns1 = ns1 & "/"
    end if

    set nodes = xmlDoc.getElementsByTagName ( "s:element" )
    for each node in nodes
        if getAttribute ( "name", node.attributes ) .text = webMethod then
            set cNode = node.childNodes ( 0 )
            if cNode.hasChildNodes then
                set sNode = cNode.childNodes ( 0 )
                if sNode.hasChildNodes then            
                    i = 0
                    for each pNode in sNode.childNodes
                        redim preserve parms ( i )
                        parms ( i ) = getAttribute ( "name", sNode.childNodes ( i ) .attributes ) .text
                        i = i + 1
                    next            
                end if
            end if
            exit for
        end if
    next

    for each node in nodes
        if getAttribute ( "name", node.attributes ) .text = webMethod & "Response" then
            set cNode = node.childNodes ( 0 )
            if cNode.hasChildNodes then
                returnsResult = true
            end if
            exit for
        end if
    next
    
    
    soapXml = "<?xml version=""1.0"" encoding=""utf-8""?>"
    soapXml = soapXml & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" "
    soapXml = soapXml & "xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" "
    soapXml = soapXml & "xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
    soapXml = soapXml & "<soap:Body>"
    soapXml = soapXml & "<" & webMethod & " xmlns=""" & ns & """>"

    i = 0
    for each p in parms
        soapXml = soapXml & "<" & p & ">"
        v = replace ( parmValues ( i ) , "&", "&amp;" )
        v = replace ( v, "<", "&lt;" )
        v = replace ( v, ">", "&gt;" )
        soapXml = soapXml & v
        soapXml = soapXml & "</" & p & ">"
        i = i + 1
    next

    soapXml = soapXml & "</" & webMethod & ">"
    soapXml = soapXml & "</soap:Body>"
    soapXml = soapXml & "</soap:Envelope>"

    set xmlSend = server.CreateObject ( "Msxml2.ServerXMLHTTP" )
    xmlSend.open "POST", url, false
    soapAction = """" & ns1 & webMethod & """"
    xmlSend.setRequestHeader "Content-Type", "text/xml"
    xmlSend.setRequestHeader "SOAPAction", soapAction
    xmlSend.send soapXml
    responseXml = xmlSend.responseText

    set soapDoc = server.CreateObject ( "Microsoft.XMLDOM" )
    soapDoc.loadXML ( responseXml )

    if returnsResult then
        webMethodResult = soapDoc.getElementsByTagName ( webMethod & "Result" ) .item ( 0 ) .text
        webMethodResult = replace ( webMethodResult, "&amp;", "&" )
        webMethodResult = replace ( webMethodResult, "&lt;", "<" )
        webMethodResult = replace ( webMethodResult, "&gt;", ">;" )         
    else
        webMethodResult = ""
    end if

    makeWebMethodRequest = webMethodResult
end function

function getAttribute ( attrName, attrs )
    dim v
    dim attr
    for each attr in attrs
        if attr.name = attrName then
            set v = attr
            exit for
        end if
    next
    set getAttribute = v
end function