<% '********************************************************************************* ' SMS Handling Routines ' June 28, 2004 VP-ASP 6.50 '*********************************************************************************** const smscentralusername="uuuuuuuuuuuu" const smscentralpassword="pppppppp" ' '*********************************************************************** ' values are set in session variables ' This allows chnage to executed code in future '*********************************************************************** sub Sendsmscentral dim smsfrom, smsphone, smsmessage smserror="" smsfrom=getsess("smsfrom") smsphone=getsess("smsphone") smsmessage=Getsess("smsmessage") Performsmscentral smsfrom, smsphone, smsmessage end sub ' '************************************** ' This subroutine formats a smscentral specific xml ' message with appropriate headers '************************************* Sub performsmscentral(fromname,tonumber,message) dim msg,url,httpresp dim colheaders 'Create the soap header collection used by smscentral set colheaders=CreateObject("Scripting.Dictionary") 'VP-ASP 6.50 - updated to match latest specifications colheaders.Add "SOAPAction", "http://www.SmsCentral.com.au/api/SendSMS" colheaders.Add "Content-Type", "text/xml; charset=utf-8" msg="" msg=msg & "" msg=msg & "" 'VP-ASP 6.50 - updated to match latest specifications msg=msg & "" msg=msg & "" & fromname & "" msg=msg & "" & tonumber & "" msg=msg & "" & message & "" msg=msg & "" & smscentralusername & "" msg=msg & "" & smscentralpassword & "" 'VP-ASP 6.50 - updated to match latest specifications msg=msg & "" msg=msg & "" msg=msg & "" url="http://smsCentral.com.au/api/sms.asmx" doxml msg,url, httpResp, colheaders If smserror<>"" or xtrace="Yes" then AnalyzeSMSCentral httpresp end if End Sub Sub AnalyzeSMSCentral(xmlresult) dim statuscode dim words(500),wordcount If xtracexml="Yes" then debugwrite "Data returned" debugwrite server.htmlencode(xmlresult) end if dim workrecord pos=0 Workrecord= Replace(xmlresult,"<","~") Workrecord= Replace(workrecord,">","~") Parserecord workrecord, words, Wordcount,"~" 'debugwrite "wordcount=" & wordcount wordloc=0 morewords=TRUE do while morewords=TRUE ' debugwrite "wordloc=" & wordloc ' debugwrite "words=" & words(wordloc) if ucase(words(wordloc))="DETAIL" then Statuscode=words(wordloc+1) morewords=false end if wordloc=wordloc+1 If wordloc>wordcount then morewords=false end if Loop 'debugwrite "shippingcount=" & shippingcount If Statuscode<>"" then smserror="Error occurred:=" & statuscode & "
" end if end sub '************************************** ' Generic xml handling routine for sms services ' Modified to use headers '************************************** Sub doxml(inStr, surl, outStr,objheaders) dim sMethod, xmlhttp If xtrace="Yes" then debugwrite "Sending data=
" & instr end if sMethod = "POST" Shopxmlhttp xCommInterface, surl, inStr, outstr, smethod, Smserror,objheaders If xtrace="Yes" then debugwrite "Returnd data=
" & outstr end if If outstr="" then smserror= smserror & "Error connecting to server " & surl & ". No data returned
" end if End sub '******************************************************** ' Invokes differnt XML or other HTTP utilities ' METHOD is POST or GET ' Shop Config xxmltype can be used as default ' Modified to handle http headers ' VP=ASP 6.50 March 10, 2004 '******************************************************** sub Shopxmlhttp (itype, iurl, indata, outdata, method, xmlerror,objheaders) 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, objheaders Case "XML3" Shopxml3http url, indata, outdata, ucmethod, xmlerror, objheaders case "XML4" Shopxml4http url, indata, outdata, ucmethod,xmlerror, objheaders case "DYNUHTTP" Shopdynuhttp url, indata, outdata, ucmethod,xmlerror, objheaders case "ASPTEAR" Shopasptear url, indata, outdata, ucmethod,xmlerror, objheaders 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,objheaders) dim tncurl, xobj, httpresp,i,key 'CODE USED TO INTIALISE ASP TEAR Const Request_POST = 1 Const Request_GET = 2 Set xobj = CreateObject("SOFTWING.ASPtear") if isobject(objheaders) then for each key in objheaders.keys xobj.addHeader key, objheaders.item(key) next end if Response.ContentType = "text/html" 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,objheaders) dim myHttp, httpHdrs,i,key Set myHttp = Server.CreateObject("DynuHttp.Http") myHttp.URL = url if isobject(objheaders) then for each key in objheaders.keys myHttp.setHeader key, objheaders.item(key) next end if myHttp.QueryString = inStr outstr = myHttp.GetURL() httpHdrs = myHttp.GetHeaders() Set myHttp = nothing End Sub ' '*************************************************************** ' XML2 '************************************************************** Sub ShopXML2http(url,inStr, outStr, method,xmlerror,objheaders) dim objhttp,i,key set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") objHttp.open method, url, false if isobject(objheaders) then for each key in objheaders.keys objHttp.setRequestHeader key, objheaders.item(key) next end if If Method="POST" Then objHttp.Send instr else objHttp.Send end if outstr=objHttp.responseText set objhttp=nothing end sub '*************************************************************** ' XML3 '************************************************************** Sub ShopXML3http(url,inStr, outStr, method,xmlerror,objheaders) dim objhttp,i,key set objhttp = Server.CreateObject ("Microsoft.XMLHTTP") objHttp.open method, url, false if isobject(objheaders) then for each key in objheaders.keys objHttp.setRequestHeader key, objheaders.item(key) next end if If Method="POST" Then objHttp.Send instr else objHttp.Send end if outstr=objHttp.responseText 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,objheaders) dim objhttp,i,key set objhttp = Server.CreateObject ("MSXML2.ServerXMLHTTP.4.0") objHttp.open method, url, false if isobject(objheaders) then for each key in objheaders.keys objHttp.setRequestHeader key, objheaders.item(key) next end if If Method="POST" Then objHttp.Send instr else objHttp.Send end if outstr=objHttp.responseText 'debugwrite "outstr=" & outstr set objhttp=nothing end sub %>