<% '******************************************************** ' Invokes differnt XML or other HTTP utilities ' METHOD is POST or GET ' Shop Confgf xxmltype can be used as default ' VP=ASP 6.50 March 12, 2003 '******************************************************** sub Shopxmlhttp (itype, iurl, indata, outdata, method, xmlerror) dim ucitype, url, ucmethod xmlerror="" outdata="" url=iurl ucmethod=UCASE(Method) if ucmethod="" then ucmethod="POST" end if If ucmethod="GET" then url = url & "?" & indata end if ucitype=ucase(Itype) if ucitype="" then ucitype=getconfig("xXMLtype") ucitype=ucase(ucitype) end if 'On error resume next 'debugwrite "url=" & url & " indata=" & indata Select Case ucitype case "XML2" Shopxml2http url, indata, outdata, ucmethod, xmlerror Case "XML3" Shopxml3http url, indata, outdata, ucmethod, xmlerror case "XML4" Shopxml4http url, indata, outdata, ucmethod,xmlerror case "DYNUHTTP" Shopdynuhttp url, indata, outdata, ucmethod,xmlerror case "ASPTEAR" Shopasptear url, indata, outdata, ucmethod,xmlerror case else outdata="Unknown XML interface" end select if err.number<> 0 then xmlerror=err.description xmlerror=xmlerror & "
Using " & Itype end if end sub ' *************************************************************** Sub ShopASPTEAR( url, inStr, outStr, method,xmlerror) dim tncurl, xobj, httpresp 'CODE USED TO INTIALISE ASP TEAR Const Request_POST = 1 Const Request_GET = 2 Set xobj = CreateObject("SOFTWING.ASPtear") Response.ContentType = "text/xml" if method="POST" then httpResp = xobj.Retrieve(url, Request_POST, instr, "", "") else httpResp = xobj.Retrieve(url, Request_GET, "", "", "") end if set xobj = nothing outstr=httpresp End sub ' *************************************************************** Sub ShopDYNUHTTP( url, inStr, outStr, method,xmlerror) dim myHttp, httpHdrs Set myHttp = Server.CreateObject("DynuHttp.Http") myHttp.URL = url myHttp.QueryString = inStr outstr = myHttp.GetURL() httpHdrs = myHttp.GetHeaders() Set myHttp = nothing End Sub ' '*************************************************************** ' XML2 '************************************************************** Sub ShopXML2http(url,inStr, outStr, method,xmlerror) dim objhttp set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") objHttp.open method, url, false 'Set header fields objHttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded" objHttp.setRequestHeader "Content-Length", len(instr) If Method="POST" Then objHttp.Send instr else objHttp.Send end if outstr=objHttp.responseXml.xml set objhttp=nothing end sub '*************************************************************** ' XML3 '************************************************************** Sub ShopXML3http(url,inStr, outStr, method,xmlerror) dim objhttp set objhttp = Server.CreateObject ("Microsoft.XMLHTTP") objHttp.open method, url, false 'Set header fields objHttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded" objHttp.setRequestHeader "Content-Length", len(instr) If Method="POST" Then objHttp.Send instr else objHttp.Send end if outstr=objHttp.responseXml.xml if (objHttp.status <> 200 ) then xmlerror="Error Connecting Error code=" & objhttp.status end if set objhttp=nothing end sub '*************************************************************** ' XML4 '************************************************************** Sub ShopXML4http(url,inStr, outStr, method,xmlerror) dim objhttp set objhttp = Server.CreateObject ("MSXML2.ServerXMLHTTP.4.0") objHttp.open method, url, false 'Set header fields objHttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded" objHttp.setRequestHeader "Content-Length", len(instr) If Method="POST" Then objHttp.Send instr else objHttp.Send end if outstr=objHttp.responseXml.xml 'debugwrite "outstr=" & outstr set objhttp=nothing end sub %>