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
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
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")
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.
Why can't the code below connect successfully to servers that require SHA2 certs? One of our partners had a SHA2 upgrade and they require us to have SHA2 certs. When we connect to their site that doesn't require SHA2 certs(only SHA1) it connects successfully with the code below. When we try to connect to a site that requires SHA2 certs(secure.anywhere.org) we get the error: Server returned error - The data necessary to complete this operation is not yet available . All of the correct SHA2 certs are installed. We have the Root and Intermediate certs installed for SHA2. Could this be an issue with WinHTTP? Or is this possibly something with our environment configuration that we need to fix?
Full error:
Server returned error: -2147483638
The data necessary to complete this operation is not yet available.
Code used to connect:
<%
On Error Resume Next
Response.ContentType = "text/html"
Dim xobj
Dim sPostData
Set xobj = CreateObject("WinHttp.WinHttpRequest.5.1")
If Err.Number <> 0 Then
Response.Write "<b>"
Response.Write "Error Creating XMLHTTP: " & Err.Number & "<BR>" & Err.Description
Response.Write "</b>"
Response.End
End If
If Not IsObject(xobj) Then
Response.Write "<b>"
Response.Write "xobj is not an object: " & Err.Number & "<BR>" & Err.Description
Response.Write "</b>"
Response.End
End If
qu = Request.form("SSN")
sPostData
sPostData = "user_id=abcd1234&password=67judlaufosaf&qu=" & qu
xobj.Open "POST", "https://www.anywhere.org/secure_area/test_panel.asp", False
xobj.setRequestHeader "Referer", "https://www2.homeu.nc.edu/tns/connect.asp"
xobj.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xobj.Send sPostData
response.buffer = True
response.clear
response.ContentType = xobj.getResponseHeader("Content-Type")
response.AddHeader "Content-Type", xobj.getResponseHeader("Content-Type")
response.BinaryWrite xobj.responseBody
If Err.Number <> 0 Then
Response.Write "<b>"
Response.Write "Server returned error: " & Err.Number & "<BR>" & Err.Description
Response.Write "</b>"
Set xobj = nothing
Response.End
End If
Set xobj = nothing
response.end
%>
This issue was due to Windows not having enough information to verify the SHA-2 cert. When we checked the status of the certs it had a status of "The issuer of this certificate could not be found". Here is a link to the solution.
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.