VBScripting‎ > ‎

Querying a web service with vbscript (SOAP 1.1)

Lots of different ways to do a SOAP/webservice call using visual basic scripting.  This is one example we did for a client.

THIS EXAMPLE IS IN SOAP 1.1 FORMAT.

Every XML message contains namespaces to properly qualify the entities within it. In SOAP 1.1 and SOAP 1.2 specifications, each had defined its own unique namespaces to define the entities belonging to those specifications.

SOAP 1.1 : http://schemas.xmlsoap.org/soap/envelope/

SOAP 1.2 : http://www.w3.org/2003/05/soap-envelope

This code slightly varies depending on your webservice.   We have noticed that many webservices return data in different formats (Json, web data, xml file, text stream).   This particular web service returned data with a bunch of HTML encoding in it.   So we had to use a function (see bottom of this page) to strip the HTML encoding from results.




CODE BEGINS:

'These are the variables we need 
Dim strSOAP
Dim url
Dim xmlhttp
Dim response

'So now we initialize our connection to the sql server
Dim adoCon         
Set adoCon = CreateObject("ADODB.Connection")
adoCon.Open "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=user;Password=password;Initial Catalog=database;Data Source=servername"


On Error Resume Next

'Step 1 generate random number.
'This web service requires a GUID to be passed to the webservice each time you issue a request (this is a security measure)
Dim pChar
pChar = "0123456789"
    pCount = Len(pChar) 
Dim guid
guid = ""
Randomize
For i = 1 To 20 ' password length
      guid = guid & Mid( pChar, 1 + Int(Rnd * pCount), 1 )
Next


'Now start to query the webservice
strSOAP=""
strSOAP = strSOAP & "<?xml version=" & chr(34) & "1.0" & chr(34) & " encoding=" & chr(34) & "utf-8" & chr(34) & "?>"
strSOAP=strSOAP & "<soapenv:Envelope xmlns:soapenv=" & chr(34) & "http://schemas.xmlsoap.org/soap/envelope/" & chr(34) & " xmlns:typ=" & chr(34) & "http://www.northgate-is.com/proiv/webservices/types" & chr(34) & ">"
strSOAP=strSOAP & "<soapenv:Header/><soapenv:Body><typ:GetJob>"
strSOAP=strSOAP & "<Authorization_ID>MyID</Authorization_ID>"
strSOAP=strSOAP & "<GUID>" & guid & "</GUID><pCompany_Code>TST</pCompany_Code><pDivision></pDivision><pStatus_Code></pStatus_Code>"
strSOAP=strSOAP & "<pProject_Manager></pProject_Manager><pSuperintendent></pSuperintendent><pEstimator></pEstimator>"
strSOAP=strSOAP & "<pCustomer_Code></pCustomer_Code><pCost_Center></pCost_Center><pSort_By></pSort_By>"
strSOAP=strSOAP & "</typ:GetJob>"
strSOAP=strSOAP & "</soapenv:Body></soapenv:Envelope>"


url="https://spectrum.ctr-inc.com:8482/ws/GetJob?wsdl"


set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.open "POST", url, FALSE
xmlhttp.setRequestHeader "Man","POST https://spectrum.ctr-inc.com:8482/ws/GetJob?wsdl HTTP/1.1"
xmlhttp.setRequestHeader "Host", "https://spectrum.ctr-inc.com:8482" 
xmlhttp.setRequestHeader "SOAPAction", "http://spectrum.ctr-inc.com:8482/ws/GetJob"
xmlhttp.setRequestHeader "Content-type", "text/xml; charset=utf-8"
xmlhttp.setRequestHeader "Content-Length", len(strSOAP)
xmlhttp.send strSOAP


'Now let's start to deal with the response
dim fs, fname, text,count

text = htmldecode(xmlhttp.responseXml.xml)
text = replace(text,"<returnElement>","")
text = replace(text,"</returnElement>","")

'Write response to a file so we have it as an archive
'set fs = CreateObject("Scripting.FileSystemObject")
'set fname=fs.CreateTextFile("\\server\getjobresults.txt",true)
'fname.Write(text)
'fname.Close
'set fname=nothing
'set fs=nothing

'Need to count how many records are in the dataset returned
count = ubound(split(text, "</jobRecord>"))

Dim startjob, endjob, job, jobstatus, jobdescription, jobcostcenter,customer
Dim objExec, sql, jobexists
Dim rs66
Set rs66 = CreateObject("ADODB.Recordset")
Dim strsql66

'Now parse each record returned
for i=1 to count

   strResponseline = split(text, "</jobRecord>")(i)
   
   startjob=instr(strResponseLine, "<Job_Number>")
   endjob = instr(strResponseLine, "</Job_Number>")
   job=Mid(strResponseline,startjob+12,(endjob-startjob-12))
   
startjob=instr(strResponseLine, "<Status_Code>")
endjob = instr(strResponseLine, "</Status_Code>")
jobstatus=Mid(strResponseline,startjob+13,(endjob-startjob-13))
If jobstatus="A" then
jobstatus="1"
End if
If jobstatus="I" then
jobstatus="0"
End if
 
   
   startjob=instr(strResponseLine, "<Job_Description>")
   endjob = instr(strResponseLine, "</Job_Description>")
   jobdescription=Mid(strResponseline,startjob+17,(endjob-startjob-17))
   
   jobdescription=replace(jobdescription,"&amp;amp;","&")
   
   startjob=instr(strResponseLine, "<Cost_Center>")
   endjob = instr(strResponseLine, "</Cost_Center>")
   jobcostcenter=Mid(strResponseline,startjob+13,(endjob-startjob-13))
   
   startjob=instr(strResponseLine, "<Customer_Code>")
   endjob = instr(strResponseLine, "</Customer_Code>")
   customer=Mid(strResponseline,startjob+15,(endjob-startjob-15))
   
  
'Now need to query T and E database to see if the job is already in database
jobexists=0
strsql66 = "Select * from tande_jobs where jobcode='" & job & "'"
rs66.open strsql66, adoCon
Do while not rs66.eof
jobexists=1
rs66.movenext
Loop
rs66.close
  
 
Next   


'msgbox "done"


'Note:  function to strip out HTML decoding
Function HTMLDecode(sText)
    Dim regEx
    Dim matches
    Dim match
    sText = Replace(sText, "&quot;", Chr(34))
    sText = Replace(sText, "&lt;"  , Chr(60))
    sText = Replace(sText, "&gt;"  , Chr(62))
    sText = Replace(sText, "&amp;" , Chr(38))
    sText = Replace(sText, "&nbsp;", Chr(32))


    Set regEx= New RegExp

    With regEx
     .Pattern = "&#(\d+);" 'Match html unicode escapes
     .Global = True
    End With

    Set matches = regEx.Execute(sText)

    'Iterate over matches
    For Each match in matches
        'For each unicode match, replace the whole match, with the ChrW of the digits.

        sText = Replace(sText, match.Value, ChrW(match.SubMatches(0)))
    Next

    HTMLDecode = sText
End Function


Comments