How can I send http command in vbs [duplicate] - vbscript

Is there a way to perform an HTTP GET request within a Visual Basic script? I need to get the contents of the response from a particular URL for processing.

Dim o
Set o = CreateObject("MSXML2.XMLHTTP")
o.open "GET", "http://www.example.com", False
o.send
' o.responseText now holds the response as a string.

You haven't at time of writing described what you are going to do with the response or what its content type is. An answer already contains a very basic usage of MSXML2.XMLHTTP (I recommend the more explicit MSXML2.XMLHTTP.3.0 progID) however you may need to do different things with the response, it may not be text.
The XMLHTTP also has a responseBody property which is a byte array version of the reponse and there is a responseStream which is an IStream wrapper for the response.
Note that in a server-side requirement (e.g., VBScript hosted in ASP) you would use MSXML.ServerXMLHTTP.3.0 or WinHttp.WinHttpRequest.5.1 (which has a near identical interface).
Here is an example of using XmlHttp to fetch a PDF file and store it:-
Dim oXMLHTTP
Dim oStream
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
oXMLHTTP.Open "GET", "http://someserver/folder/file.pdf", False
oXMLHTTP.Send
If oXMLHTTP.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write oXMLHTTP.responseBody
oStream.SaveToFile "c:\somefolder\file.pdf"
oStream.Close
End If

If you are using the GET request to actually SEND data...
check:
http://techhelplist.com/index.php/tech-tutorials/37-windows-troubles/60-vbscript-sending-get-request
The problem with MSXML2.XMLHTTP is that there are several versions of it, with different names depending on the windows os version and patches.
this explains it:
http://support.microsoft.com/kb/269238
i have had more luck using vbscript to call
set ID = CreateObject("InternetExplorer.Application")
IE.visible = 0
IE.navigate "http://example.com/parser.php?key=" & value & "key2=" & value2
do while IE.Busy....
....and more stuff but just to let the request go thru.

strRequest = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" " &_
"xmlns:tem=""http://tempuri.org/"">" &_
"<soap:Header/>" &_
"<soap:Body>" &_
"<tem:Authorization>" &_
"<tem:strCC>"&1234123412341234&"</tem:strCC>" &_
"<tem:strEXPMNTH>"&11&"</tem:strEXPMNTH>" &_
"<tem:CVV2>"&123&"</tem:CVV2>" &_
"<tem:strYR>"&23&"</tem:strYR>" &_
"<tem:dblAmount>"&1235&"</tem:dblAmount>" &_
"</tem:Authorization>" &_
"</soap:Body>" &_
"</soap:Envelope>"
EndPointLink = "http://www.trainingrite.net/trainingrite_epaysystem" &_
"/trainingrite_epaysystem/tr_epaysys.asmx"
dim http
set http=createObject("Microsoft.XMLHTTP")
http.open "POST",EndPointLink,false
http.setRequestHeader "Content-Type","text/xml"
msgbox "REQUEST : " & strRequest
http.send strRequest
If http.Status = 200 Then
'msgbox "RESPONSE : " & http.responseXML.xml
msgbox "RESPONSE : " & http.responseText
responseText=http.responseText
else
msgbox "ERRCODE : " & http.status
End If
Call ParseTag(responseText,"AuthorizationResult")
Call CreateXMLEvidence(responseText,strRequest)
'Function to fetch the required message from a TAG
Function ParseTag(ResponseXML,SearchTag)
ResponseMessage=split(split(split(ResponseXML,SearchTag)(1),"</")(0),">")(1)
Msgbox ResponseMessage
End Function
'Function to create XML test evidence files
Function CreateXMLEvidence(ResponseXML,strRequest)
Set fso=createobject("Scripting.FileSystemObject")
Set qfile=fso.CreateTextFile("C:\Users\RajkumarJoshua\Desktop\DCIM\SampleResponse.xml",2)
Set qfile1=fso.CreateTextFile("C:\Users\RajkumarJoshua\Desktop\DCIM\SampleReuest.xml",2)
qfile.write ResponseXML
qfile.close
qfile1.write strRequest
qfile1.close
End Function

Related

VBScript - Assign source code of web page to variable

I'm trying to write a VBScript that looks navigates a website based on the content of that website. To do that, I need to be able to assign the source code of each web page to a string variable and have the script look through that string for certain words.
I have seen this proposed as a solution:
Function GetSourceCode(url)
Set objHttp = CreateObject("Microsoft.XMLHTTP")
bGetAsAsync = False
objHttp.open "GET", url, bGetAsAsync
objHttp.send
If objHttp.status <> 200 Then
wscript.Echo "unexpected status = " & objHttp.status & vbCrLf & objHttp.statusText
wscript.Quit
End If
'MsgBox objHttp.responseText
GetSourceCode = objHttp.responseText
End Function
but that does not work. I've seen elsewhere that this is possible with AutoIT, but I cannot use AutoIT per security policy.
Any ideas?
Change Microsoft.XMLHTTP to Msxml2.ServerXMLHTTP
Function GetSourceCode(url)
Set objHttp = CreateObject("Msxml2.ServerXMLHTTP")
bGetAsAsync = False
objHttp.open "GET", url, bGetAsAsync
objHttp.send
If objHttp.status <> 200 Then
wscript.Echo "unexpected status = " & objHttp.status & vbCrLf & objHttp.statusText
wscript.Quit
End If
'MsgBox objHttp.responseText
GetSourceCode = objHttp.responseText
End Function
WScript.Echo GetSourceCode("https://anothervps.com/api/phpver")

MSXML ServerXMLHTTP- Calling web service

Problem: I am getting the following error output from If Err.Number <> 0 Then check;
Err.Number :-1072954818
Err.Source :msxml6.dll
Err.Source :This method cannot be called until the open method has been called.
Code:
dim objHttpRequest
dim gw_menu_request
dim HTTPMethod
HTTPMethod="POST"
Set objHttpRequest = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0")
gw_menu_request = "http://test.com?q=headerexpose/expose_headers/expose_json"
objHttpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHttpRequest.setRequestHeader "Content-Length", 0
objHttpRequest.open HTTPMethod, gw_menu_request, false
Response.write(objHttpRequest.ResponseXML)
If Err.Number <> 0 Then
Response.Write "Err.Number :" & Err.Number & "<br/>"
Response.Write "Err.Source :" & Err.Source & "<br/>"
Response.Write "Err.Source :" & Err.Description & "<br/>"
Response.Write "Err.File :" & Err.File & "<br/>"
End If
What am I missing here?
The issue is exactly as the described in the error, you are trying to set Request Headers without first calling Open(). You are also missing the Send() method to send the request before a response can be received.
Dim objHttpRequest
Dim gw_menu_request
Dim HTTPMethod
HTTPMethod="POST"
Set objHttpRequest = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0")
gw_menu_request = "http://test.com?q=headerexpose/expose_headers/expose_json"
'Open request specifying method and URL to call
objHttpRequest.open HTTPMethod, gw_menu_request, False
'Set any HTTP headers needed before sending.
objHttpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHttpRequest.setRequestHeader "Content-Length", 0
'Send the request
objHttpRequest.Send
Response.write(objHttpRequest.ResponseXML.Xml)
If Err.Number <> 0 Then
Response.Write "Err.Number :" & Err.Number & "<br/>"
Response.Write "Err.Source :" & Err.Source & "<br/>"
Response.Write "Err.Source :" & Err.Description & "<br/>"
Response.Write "Err.File :" & Err.File & "<br/>"
End If
You also want ResponseXML.Xml or you will receive a
Microsoft VBScript runtime error: Type mismatch
because you are trying to output the object not the Xml property that contains the XML string representation.

Vbscript Get proxy config for WinINET API

I'm trying to send a HTTP get to an internal webserver and this works fine unless due to rerouting reasons, a user has to traverse a proxy in order to get to the webserver, then I just get a WinInet 12029 error of "ERROR_INTERNET_CANNOT_CONNECT The attempt to connect to the server failed." Please can you help me pull in the existing Internet Options proxy config? I don't want to define the proxy credentials statically (nor have I tried).
My code:
Function HTTPGet1
Dim o, URL, stat
URL = myURL
On Error Resume Next
Set o = CreateObject("Microsoft.XMLHTTP")
' If Err.Number <> 0 Then
'msgbox err.Number & err.Description
'msgbox "cake"
'Exit Function
' End if
o.WinHttpGetIEProxyConfigForCurrentUser
o.open "GET", URL, False
o.send
stat = o.Status 'CInt(o.Status)
if stat = "200" then
msgbox "Account created successfully."
elseif stat = "" then
msgbox "Connection attempt failed due to: " & err.description & "."
err.clear
else
msgbox "HTTP error code " & stat & " received."
end if
end function
Thanks for your time!
Use the latest version of ServerXMLHTTP object
Set xHttp= CreateObject("MSXML2.ServerXMLHTTP.6.0")
xHttp.Open "POST", SERVER_URL, data, False
xHttp.setProxy 2, "<Your proxy URL>:<PORT>", ""
xHttp.send
response = xHttp.responseText
msgbox xHttp.status & "|" & xHttp.statustext
msgbox "Response for get call is :" & response
A pcap uncovered that the server was responding with a SSL cert error that this API couldn't respond to. I swapped it out for MSXML2.ServerXMLHTTP.6.0 and then was able to handle the host name mismatch.
Function HTTPGet1
Dim o, address, caseNo, URL, stat
URL = myURL
On Error Resume Next
Set o = CreateObject("MSXML2.ServerXMLHTTP.6.0")
If Err.Number <> 0 Then
msgbox err.Number & err.Description
err.clear
Exit Function
End if
o.setOption 2, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
o.open "GET", URL, False
o.send
stat = o.Status
The parameter 'SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS' is just one of the options available via the API and this one is not the most secure.

How do I force VB6 to POST using TSL encryption?

The company where I work has an old VB6 application that they want to force to use TSL, rather than SSL. I looked at the code, and told them they should be fine. The code does a post to the client website using HTTPS. It doesn't specify what encryption to use.
This is the relevant code:
Sub PostXML()
Dim XMLHttpRequest As MSXML2.XMLHTTP
Dim TempString As String
Dim strURL As String
Dim strArgs As String
strURL = gPostWebServer & "/" & gPostFile
'ARB 1/8/2004 This is to trap if send fails and allow it to continue.
On Error GoTo errorHandler:
If Not XMLHttpRequest Is Nothing Then Set XMLHttpRequest = Nothing
Set XMLHttpRequest = New MSXML2.XMLHTTP
strArgs = "?Username=" & gPostUserName & "&Password=" & gPostPassword
XMLHttpRequest.Open "POST", strURL & strArgs, False
XMLHttpRequest.send dom_GlobalXMLObject
If XMLHttpRequest.Status >= 400 And XMLHttpRequest.Status <= 599 Then
TempString = "Client Website is not available. Order was not posted successfully ..."
flgOrderPostSuccess = False
strOrderPostError = TempString
Else
TempString = XMLHttpRequest.responseText
'Parse the response
Dim sValid As String
Dim sComments As String
Dim sTimeStamp As String
Dim oRoot As MSXML2.IXMLDOMElement
Dim lNodes As MSXML2.IXMLDOMNodeList
Dim oNodes As MSXML2.IXMLDOMElement
Dim lNodes1 As MSXML2.IXMLDOMNodeList
Dim oNodes1 As MSXML2.IXMLDOMElement
Dim lNodes2 As MSXML2.IXMLDOMNodeList
Dim oNodes2 As MSXML2.IXMLDOMElement
Call Set_Global_XML_Object
dom_GlobalXMLObject.loadXML (TempString)
dom_GlobalXMLObject.Save (Report_Folder & "\Response.xml")
'Get the root of the XML tree.
Set oRoot = dom_GlobalXMLObject.documentElement
If Not oRoot Is Nothing Then
Set lNodes = oRoot.childNodes
For Each oNodes In lNodes
Select Case oNodes.nodeName
Case "Acknowledgement"
Set lNodes1 = oNodes.childNodes
For Each oNodes1 In lNodes1
Select Case oNodes1.nodeName
Case "Received"
sTimeStamp = Trim(oNodes1.nodeTypedValue)
Case "Validated"
sValid = Trim(oNodes1.nodeTypedValue)
Case "Errors"
Set lNodes2 = oNodes1.childNodes
For Each oNodes2 In lNodes2
Select Case oNodes2.nodeName
Case "Description"
sComments = sComments & vbCrLf & Trim(oNodes2.nodeTypedValue)
End Select
Set oNodes2 = Nothing
Next
Set lNodes2 = Nothing
End Select
Set oNodes1 = Nothing
Next
Set lNodes1 = Nothing
End Select
Next
If UCase(sValid) = "YES" Then
TempString = sTimeStamp & " " & "Order uploaded successfully"
flgOrderPostSuccess = True
strOrderPostError = ""
Else
TempString = "Order had following problems:" & vbCrLf
TempString = TempString & sComments
strOrderPostError = TempString
End If
Else 'Non XML response
TempString = Replace(TempString, vbCr, vbCrLf)
TempString = "Order had following problems:" & vbCrLf & TempString
strOrderPostError = TempString
End If
End If
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Call FillLogTextBox(TempString)
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Set oRoot = Nothing
Set lNodes = Nothing
Set oNodes = Nothing
Set lNodes1 = Nothing
Set oNodes1 = Nothing
Set lNodes2 = Nothing
Set oNodes2 = Nothing
Set XMLHttpRequest = Nothing
Exit Sub
errorHandler:
TempString = Err.DESCRIPTION
If InStr(1, TempString, "Method") > 0 Or InStr(1, Err.DESCRIPTION, "failed") > 0 Then
TempString = "Client Website was not found. Order was not posted successfully..."
Call FillLogTextBox(TempString)
Call FillLogTextBox("-----------------------------------------------" & vbCr)
Exit Sub
End If
End Sub
When the client switched from SSL to TSL last weekend, everything worked, except the posts from this one old VB6 app. (So I'm told, anyways. This isn't an application I've supported before.)
We have other VB6 apps that I maintain, but none do a POST out of VB6. All of them use BizTalk for posting.
The client has given us until next Wednesday to fix our app. So, the powers that be want me to force the app to use TSL.
Normally, I don't have problems with VB6, but I've never tried forcing the encryption used to POST. Generally, when we did POST out of the other VB6 apps, they negotiated with Windows on their own, and took care of things. While I've seen successful attempts to force VB6 to use TSL when sending an email, I've never seen anyone do it for POSTing.
All that being said, does anyone know how to force VB6 to use TSL when POSTing?
Thanks
With SChannel you cannot control available/used protocols and ciphers at an application level, you have to configure SChannel protocols/ciphers on the Win2003 box at system level. Here is KB on the subject: http://support.microsoft.com/kb/245030
To disable SSLv3 for both inbound and outbound connections merge something like this in registry (and reboot):
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0]
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Client]
"DisabledByDefault"=dword:00000001
"Enabled"=dword:00000000
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Server]
"Enabled"=dword:00000000
"DisabledByDefault"=dword:00000001
While there make sure SSLv2 is nuked too.
You might prefer to use IISCrypto -- a nice utility that makes SSL/TLS protocols/ciphers registry config trivial.

Post data with https does not get processed at Server side

I am having a VBScript which gets invoked from a 3rd party application, the script gets the data from the 3rd party application and opens the URL in an IE browser by passing the data in POST format. The script works fine when I use http as the protocol but the moment I use https, the server side code (request.getParameter("param1")) complains that it is not able to find the parameter in the request object. The script is called by passing the URL and the data. e.g. run.vbs https://xyz.com?param1=1234. Following is the vbscript for your kind perusal. Can you please let me know what I am missing when I am using https as the protocol. Any help is highly appreciated. Many thanks.
If WScript.Arguments.Count = 1 Then
uri = WScript.Arguments.Item(0)
'WScript.Echo "Arguments " & uri
Set WshNetwork = WScript.CreateObject("WScript.Network")
'WScript.Echo "Current User Name: " & WshNetwork.UserName
filename="C:\Documents and Settings\"+WshNetwork.UserName+"\Application Data\XYZ\Profiles\default\Settings.xml"
'WScript.Echo "Current User fileName: " & filename
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(filename)
strQuery = "Agent"
Set colItem = xmlDoc.getElementsByTagname(strQuery)
For Each objItem in colItem
Agentid = objItem.getAttribute("Login")
'MsgBox "AgentId = " + AgentID
Next
'uri = uri+"^&agentid="+Agentid
uri = uri+"&agentid="+Agentid
pos = InStr(uri,"?")
extracteduri = Mid(uri,1,pos-1)
params = Mid(uri, pos+1)
postdata = Str2Bytes(params,"us-ascii")
header = "Content-Type: application/x-www-form-urlencoded"
Set IE = CreateObject("InternetExplorer.Application")
'IE.Navigate "about:blank"
'IE.AddressBar = True
'IE.ToolBar = True
'IE.StatusBar = True
IE.Visible = True
'WScript.Sleep 2000
Set shl = WScript.CreateObject("WScript.Shell")
shl.SendKeys "% X"
IE.Navigate extracteduri, Nothing, Nothing, postdata, header
Wscript.Quit
Else
Wscript.Echo "Usage: RunURL.vbs <URL to invoke>"
Wscript.Quit
End If
Function Str2Bytes(Text, CharSet)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
If Len(CharSet) > 0 Then
BinaryStream.CharSet = CharSet
Else
BinaryStream.CharSet = "us-ascii"
End If
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Str2Bytes = BinaryStream.Read
End Function
I am now using the below function to get the response from the server using https as the protocol and POST as the format but still the server is not able to see the parameter
Set req = CreateObject("MSXML2.ServerXMLHTTP")
'Set the below option to get rid of the "Certificate authority is invalid or
'incorrect, error code - 80072F0D" error
req.setOption 2, 13056
req.open "POST", extracteduri, False
req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
encodedParams = Escape(params)
WScript.Echo "encodedParams: " & encodedParams
req.send encodedParams
WScript.Echo "req.responseText: " & req.responseText
Below are the encoded parameters
uui%3DU1%3D123456%26agentid%3D123456
The server still complains that the parameter is missing from the request object.
I am using the same script (XMLHTTP request) but I am encrypting the parameters using the Str2Bytes function (declared above)
Set req = CreateObject("MSXML2.ServerXMLHTTP")
req.setOption 2, 13056
req.open "POST", extracteduri, False
req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
req.send postdata
WScript.Echo "req.responseText: " & req.responseText
I'd recommend using an XMLHTTPRequest instead of the Internet Explorer COM object. See here for an example. Note that you must encode special characters in the post data.
However, if you want to open the URL in IE anyway, you'd probably better stick with your original approach. In that case I'd check the server for more information about why the server side thinks it cannot find the parameter. Does the request even have a parameter named "param1"?

Resources