How to check if RSS address is accessible [duplicate] - vbscript

This question already has answers here:
HTTP GET in VBS
(4 answers)
Closed 2 years ago.
I am using classic asp/vbscript to load a RSS. In this case the URL should start with https rather than http so I get the error : Access is denied. How can I check if the target url is accessible and healthy and the use it?
Set xmlDOM = CreateObject("MSXML2.DOMDocument.6.0")
xmlDOM.async = False
xmlDOM.setProperty "ServerHTTPRequest", True
xmlDOM.Load("http://iqna.ir/fa/rss/services/36")
I have tried to wrap it inside if/then but obviously will result in the same error:
if (xmlDOM.Load("http://iqna.ir/fa/rss/services/36")) then
'Proceess the RSS content
end if

xmlDOM.Load directly loads the target resource and has no method to check the validity of target url. Use MSXML2.XMLHTTP to check tha target validity:
function testUrl(url)
Set o = CreateObject("MSXML2.XMLHTTP")
on error resume next
o.open "GET", url, False
o.send
if o.Status = 200 then testUrl = True
on error goto 0
set o=nothing
end function
Set xmlDOM = CreateObject("MSXML2.DOMDocument.6.0")
xmlDOM.async = False
xmlDOM.setProperty "ServerHTTPRequest", True
url="http://iqna.ir/fa/rss/services/36"
if testUrl(url) then
xmlDOM.Load(url)
end if
Regarding the comment from Lankymart this is the way to consume the MSXML2 response directly without a new request by chaning Load to loadXML:
url="http://iqna.ir/fa/rss/services/36"
Set o = CreateObject("MSXML2.XMLHTTP")
on error resume next
o.open "GET", url, False
o.send
if o.Status = 200 then
Set xmlDOM = CreateObject("MSXML2.DOMDocument.6.0")
xmlDOM.loadXML(o.responseText)
end if
on error goto 0
set o=nothing

Related

How to fix error of "Object connection lost from its client" in VBscript"?

my code where I try to login into the website automatically. But it keeps on throwing
The object is lost connection from its client
Dim IE
set IE = WScript.CreateObject("InternetExplorer.Application")
IE.Visible = true
Call IE.navigate("http://finrpa:8080/controlroom/")
Do While IE.ReadyState <> 4
WScript.Sleep 10
Loop
IE.Document.all.username-inputEl.Value = "parthiban.nadar#thirdware.com"
IE.Document.all.password-inputEl.Value = "Thirdw#re1"
Call IE.Document.all.gaia_loginform.submit
Set IE = Nothing
What line the exception is thrown?
I see at least one problem with the script. Because the control names contain dashes, they should be strings. So, instead of
IE.Document.all.username-inputEl.Value = "parthiban.nadar#thirdware.com"
IE.Document.all.password-inputEl.Value = "Thirdw#re1"
should be
IE.Document.getElementById("username-inputEl").Value = "parthiban.nadar#thirdware.com"
IE.Document.getElementById("password-inputEl").Value = "Thirdw#re1"

Classic ASP XMLHttp Send very slow

I've inherited a classic asp project and as part of the upgrade process we're moving a lot of the business logic to a REST API (WebApi 2.2)
The authorization endpoint for the api is written, and the asp site can call it, but it's very slow compared with calling directly via Postman.
(I'm a C# coder not a VBScript one so the below code may be offensive)
Asp Code:
' Send a prebuilt HTTP request and handle the response
' Returns true if the request returns a 200 response, False otherwise
' Response body is placed in Response
' ErrorMessage is set to return status text if an error code is returned
Function HandleRequest(ByRef objRequest, strBody)
set profiler = Server.CreateObject("Softwing.Profiler")
HandleRequest = False
' Add auth token if we have it
If Not m_accessToken&"" = "" Then
objRequest.SetRequestHeader "Authorization", "Bearer " & m_accessToken
End If
' Originating IP for proxy forwarding
If Not m_clientIp&"" = "" Then
objRequest.SetRequestHeader "X-Forwarded-For", m_clientIp
End If
On Error Resume Next
If (strBody&"" = "") Then
objRequest.Send()
Else
profiler.ProfileStart()
objRequest.Send(strBody)
flSendRequest = profiler.ProfileStop()
End If
If Err.Number = 0 Then
Dim jsonResponse
If (objRequest.ResponseText&"" <> "") Then
profiler.ProfileStart()
set jsonResponse = JSON.parse(objRequest.ResponseText)
flJson = profiler.ProfileStop()
set m_Response = jsonResponse
End If
If objRequest.Status = 200 Then
HandleRequest = True
m_errorMessage = ""
Else
m_errorMessage = objRequest.statusText
End If
Else
m_errorMessage = "Unable to connect to Api server"
End If
On Error GoTo 0
End Function
You can see there's some profiling code in there.
The following post request takes 392ms
POST localhost:5000/oauth/token
Content-Type application/x-www-form-urlencoded
client_id:ABCDEF0-ABCD-ABCD-ABCD-ABCDEF-ABCDEF01234
client_secret:aBcDeF0123456789aBcDeF0123456789=
username:demo
password:demo
grant_type:password
If I issue the same request direct to the Api via Postman it takes 30ms.
That's more than 13x slower.
What gives?
Edit
Raw result from Softwing Profiler:
flJson 10.9583865754112
flSendRequest 392.282022557137
So after a lengthy-ish discussion with the #J-Tolley it looks as though the issue is with the Softwing.Profiler documentation which states;
all results are given in milliseconds
even though earlier in the page it states;
has a ten milliseconds resolution
Have not used the Softwing.Profiler component alone before and would recommend anyone using in a Classic ASP environment to implement it using the SlTiming class library provided by 4GuysFromRolla.
In that article it even warns anyone using the Softwing.Profiler ProfileStop() method to;
Be aware that Softwing.Profiler's ProfileStop method returns a value in ticks (tenths of milliseconds).

Getting response text from server

I am trying to get the text inside a file in the folder structure of my site using the Microsoft.XmlHttp, then compare it with my version.txt on my local PC. if the same, it will prompt a message that it contains the same version, else it will display the opposite.
URL="http://www.example.org/sites/default/files/version.txt"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
On Error Resume Next
http.open "GET", URL, False
http.send ""
if http.status = 200 Then
server_version = http.responseText
End if
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objClientVersion = objFSO.OpenTextFile("C:\mcgfiles\avp\hash.txt",1)
client_version = objClientVersion.ReadLine
comparison = StrComp(server_version, client_version)
If comparison = 0 Then
Wscript.Echo "the same"
Else
Wscript.Echo "not the same"
End If
kinda work, but each time i try to change the contents of the http://www.example.org/sites/default/files/version.txt from my server, this scripts still gets the old value: for example, the values of the http://www.example.org/sites/default/files/version.txt before is 123456, when I run the script it gets the 123456. When I change the value to 654321 and run this script, it still gets the old value which is 123456. Help Thanks
Disable response caching:
http.open "GET", URL, False
http.setRequestHeader "Cache-Control", "no-cache,max-age=0"
http.setRequestHeader "Pragma", "no-cache"
http.send
Also, you may want to replace ReadLine with ReadAll, because the former will only read the first line of the local file, while the HTTP request returns the entire remote file.

Read files from URL

Is it possible to read files like .css and .js from a URL? For instance, I have a file, which is located at http://main/shared/css/main.css, and want to read this file and store its content in another file at c:\main.txt. I know how to read files in local drives but not sure how to do it for a URL. Any help is much appreciated.
You can use an XMLHttpRequest for this:
url = "http://main/shared/css/main.css"
Set req = CreateObject("Msxml2.XMLHttp.6.0")
req.open "GET", url, False
req.send
If req.Status = 200 Then
Set fso = CreateObject("Scripting.FileSystemObject")
fso.OpenTextFile("C:\main.txt", 2).Write req.responseText
End If
Yes as long as you know the file names in question you should be able to do a simple XMLHttpRequest
url = "http://main/shared/css/main.css"
Set req = CreateObject("Msxml2.XMLHttp.6.0")
req.open "GET", url, False
req.send
If req.Status = 200 Then
Set fso = CreateObject("Scripting.FileSystemObject")
fso.OpenTextFile("C:\main.txt", 8, true, 0).Write req.responseText
End If
A slight amend to the OpenTextFile line so the text file is created
locally if it does not exist.

Handle Events from WinHttpRequest

A program I use runs .VBS scripts
So, in VBScript how can you handle the OnResponseFinished event for a WinHttpRequest object?
Set oHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
oHTTP.Open "GET", "http://www.google.com", True
oHTTP.Send
I was trying to get some code executed when the winhttp response comes (using VBScript inside HTA file). You may consider putting your event code right after the send. Using the following code, the user interface does not hang when waiting for the response:
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Open "GET", "http://www.google.com", True
objHTTP.Send
objHTTP.WaitForResponse 'pauses execution, but does not hang UI
'from now on, execution only takes effect after completion of the response:
msgbox objHTTP.responseText 'an example of what can be done with the response
This seems to be the same as synchronous winhttp for script files, which can be what you are looking for. So, the only difference may be noticed when using an user interface.
Change the third paramater in the call to the Open method to false. Then place the code you would have in OnResponseFinished after the call to send.
Use WScript's CreateObject not the built in one for event handler.
Set oHTTP = WScript.CreateObject(
"WinHttp.WinHttpRequest.5.1",
"oHTTP_"
)
I'll admit his isn't a great answer, but the usual way to register VBScript events is to use the GetRef function to get a reference to the event handler, eg with an MSXML2.XMLHTTP object:
Set oHTTP = CreateObject("MSXML2.XMLHTTP")
oHTTP.Open "GET", "http://www.google.com", True
oHTTP.OnReadyStateChange = GetRef("oHTTP_OnReadyStateChange")
Sub oHTTP_OnReadyStateChange
' do something
End sub
oHTTP.Send
The trouble is, I tried it for your code, ie
Set oHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
oHTTP.Open "GET", "http://www.google.com", True
oHTTP.OnResponseFinished = GetRef("oHTTP_OnResponseFinished")
Sub oHTTP_OnResponseFinished
' do something
End sub
oHTTP.Send
and it didn't work, getting the error
Object doesn't support this property or method: 'oHTTP.OnResponseFinished'
but perhaps this can give you a starting point , or maybe you can use the MSXML2 library instead?
Just updating this answer with the other way of handling COM events - use the second parameter for the CreateObject function which allows you to specify the function prefix which connects functions to objects, eg
Set oHTTP = CreateObject("WinHttp.WinHttpRequest.5.1", "oHTTP_")
oHTTP.Open "GET", "http://www.google.com", True
Sub oHTTP_OnResponseFinished
' do something
End sub
oHTTP.Send
unfortunately, this doesn't work either - it must be that the IWinHttpRequestEvents interface is inaccessible
I checked the Windows Registry and there appears to be a number of Microsoft objects that do nearly the same thing:
Microsoft.XMLHTTP {ED8C108E-4349-11D2-91A4-00C04F7969E8}
MSXML2.XMLHTTP {F6D90F16-9C73-11D3-B32E-00C04F990BB4}
WinHttp.WinHttpRequest.5.1 {2087c2f4-2cef-4953-a8ab-66779b670495}
MSXML2.ServerXMLHTTP {AFBA6B42-5692-48EA-8141-DC517DCF0EF1}
What works for me is Microsoft.ServerXMLHTTP which allows setting of the onreadystatechange in VBScript. The "MSXML2.ServerXMLHTTP" handles redirecting websites (e.g. google.com) which makes it a better choice over "Microsoft.XMLHTTP".
Dim xmlhttp ' global so can be accessed in OnStateChange
Sub OnStateChange
If xmlhttp.readystate = 4 Then
' React to xmlhttp.responseText
MsgBox xmlhttp.responseText
End If
End Sub
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "GET", "http://www.google.com/", true
xmlhttp.onreadystatechange = GetRef("OnStateChange")
xmlhttp.send
' do something else whilst xmlhttp is running in the background
MsgBox "Pausing so that OnStateChange can fire!"
It does need seem to be possible according to this (go to remarks) you can only access the error state with Err. Microsoft's documentation is lousy.
I found that I can get this to work Asynchronously by using the 'waitForResponse' with parameter '0' for the timeout method as a flag.
IE:
oHTTP.Open "GET", "http://www.google.com", True
oHTTP.Send
Do While oHTTP.waitForResponse(0) = False
'do stuff while waiting for it to be done
WScript.Sleep 200 'sleep for 0.2 seconds between checks as not waste CPU
DoEvents
Loop
'Once the loop is exited, the response is finished
MsgBox oHTTP.ResponseText

Resources