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")
Related
I used the following code to check if a RSS url responds in 5 seconds so I can consume the RSS feed however trying to open the URL causes error when the target URL could not be resolved. What more I need rather than waitForResponse to also handle this situation?
Set http = Server.CreateObject("MSXML2.ServerXMLHTTP")
http.open "POST", "https://persiadigest.com/fa/rss/8", True
http.send
If http.waitForResponse(5) Then
body=http.responsetext
Else
response.write "Target url is not responding"
End If
Set http = Nothing
Error details:
msxml3.dll error '80072ee7' The server name or address could not be
resolved
Give a try for this example and tell me the results :
Option Explicit
Dim Title : Title = "Get RSS FEED"
Dim ArrURL : ArrURL = Array("https://persiadigest.com/fa/rss/8","http://khabarfoori.com/rss/mm")
Dim URL
For Each URL in ArrURL
If CheckURL(URL) = "200" Then
MsgBox chr(34) & URL & chr(34) & " ==> is active"& vbCrLF &_
"Status : " & CheckURL(URL),vbInformation,Title
MsgBox GetDataFromURL(URL,"GET",""),vbInformation,Title
Else
MsgBox chr(34) & URL & chr(34) & " ==> is inactive" & vbCrLF &_
"Status : " & CheckURL(URL),vbCritical,Title
End if
Next
'---------------------------------------------------------------------------
Function GetDataFromURL(strURL, strMethod, strPostData)
Dim lngTimeout
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
Dim strHostOverride
Dim strLogin
Dim strPassword
Dim strResponseText
Dim objWinHttp
lngTimeout = 59000
strUserAgentString = "http_requester/0.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open strMethod, strURL
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
If (strLogin <> "") And (strPassword <> "") Then
objWinHttp.SetCredentials strLogin, strPassword, 0
End If
On Error Resume Next
objWinHttp.Send(strPostData)
If Err.Number = 0 Then
If objWinHttp.Status = "200" Then
GetDataFromURL = objWinHttp.ResponseText
Else
GetDataFromURL = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
Set objWinHttp = Nothing
End Function
'---------------------------------------------------------------------------
Function CheckURL(vURL)
On Error Resume Next
Dim xhr
Set xhr = CreateObject("MSXML2.ServerXMLHTTP.3.0")
xhr.Open "HEAD", vURL, false
xhr.Send
If Err.Number = 0 Then
'MsgBox xhr.status
CheckURL = xhr.status
Else
CheckURL = Err.Description
End If
End Function
'---------------------------------------------------------------------------
A simple function that ignores errors would work.
Function WaitIgnoreError(ByRef requestObject, timeout)
On Error Resume Next
WaitIgnoreError = requestObject.WaitForResponse(timeout)
End Function
Usage:
If WaitIgnoreError(http, 5) Then
body = http.responsetext
Else
response.write "Target url is not responding"
End If
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
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.
I am attempting to merge parts of several wiki pages to create a condensed/summarized version.
The following code works for pages like google.com.
But, it's returning a blank result for the page I want.
Any suggestions?
Set o = CreateObject("MSXML2.ServerXMLHTTP.6.0")
o.open "GET", "http://stevescarts2.wikispaces.com/Modules", False
o.send
If err.number = 0 then
MsgBox o.responseText
Else
MsgBox "error " & err.number & ": " & err.description
End If
There is no response text. The server responds with status 302 Found to that request. Always check the status when dealing with XMLHTTP requests:
WScript.Echo o.status & " " & o.statusText
Thanks, Ansgar.
Much appreciated.
Here's the modified code that works for me...
Set o = CreateObject("MSXML2.ServerXMLHTTP.6.0")
url = "http://stevescarts2.wikispaces.com/Modules"
Do
o.open "GET", url, False
o.send
If o.Status = 302 Then
url = o.GetResponseHeader("Location")
End If
Loop Until err.number = 0 And o.Status <> 302
If err.number = 0 then
MsgBox o.responseText
ElseIf o.status & " " & o.statusText Then
MsgBox "error " & err.number & ": " & err.description
End If
I have a script which is able to download files from the https://mysite.com/xxx.zip but when it goes to a secured link, I want to accept the certificate. There is a huge problem here. I am not able to use "ServicePointManager.ServerCertificateValidationCallback" effectively.
Can anyone please help?
I also have the domain for the certificate site: *.mysite.com
code:
Const scriptVer = "1.0"
Const DownloadDest = "https://mysite.com/xxx.zip"
Const LocalFile = "F:\Testing\xxx.zip"
Const webUser = "admin"
Const webPass = "admin"
Const DownloadType = "binary"
dim strURL
function getit()
dim xmlhttp
set xmlhttp=createobject("MSXML2.XMLHTTP.3.0")
'xmlhttp.SetOption 2, 13056 'If https -> Ignore all SSL errors
strURL = DownloadDest
Wscript.Echo "Download-URL: " & strURL
'For basic auth, use the line below together with user+pass variables above
xmlhttp.Open "GET", strURL, false, WebUser, WebPass
'xmlhttp.Open "GET", strURL, false
xmlhttp.Send
Wscript.Echo "Download-Status: " & xmlhttp.Status & " " & xmlhttp.statusText
If xmlhttp.Status = 200 Then
Dim objStream
set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.Write xmlhttp.responseBody
objStream.SaveToFile LocalFile
objStream.Close
set objStream = Nothing
End If
set xmlhttp=Nothing
End function
'=======================================================================
' End Function Defs, Start Main
'=======================================================================
' Get cmdline params and initialize variables
If Wscript.Arguments.Named.Exists("h") Then
Wscript.Echo "Usage: http-download.vbs"
Wscript.Echo "version " & scriptVer
WScript.Quit(intOK)
End If
getit()
Wscript.Echo "Download Complete. See " & LocalFile & " for success."
Wscript.Quit(intOK)
ServicePointManager.ServerCertificateValidationCallback = AddressOf AcceptAllCertifications
Private Shared Function ValidateCertificate(sender As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) As Boolean
return True
End Function
ServicePointManager is a .NET class, so it can't be used in VBScript. Try this instead:
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.setOption 2, 13056
You must use MSXML2.ServerXMLHTTP here, because MSXML2.XMLHTTP requests don't have the setOption method.
And perhaps you shouldn't broadcast your questions. It's not very polite.