The bounty expires in 4 days. Answers to this question are eligible for a +50 reputation bounty.
HelloCW is looking for an answer from a reputable source.
I'm a beginner of vbs, the Code A is written using vbs, it works well.
I find there are many repeated code in Code A, how to optimize the vbs code ?
Code A
Call Send_HTTP_RequestA()
Call Send_HTTP_RequestB()
Sub Send_HTTP_RequestA()
'Force the script to finish on an error.
On Error Resume Next
'Declare variables
Dim objRequest
Dim URL
Set objRequest = CreateObject("Microsoft.XMLHTTP")
'Put together the URL link appending the Variables.
URL = "http://www.a.com/Task.aspx"
'Open the HTTP request and pass the URL to the objRequest object
objRequest.open "POST", URL , false
'Send the HTML Request
objRequest.Send
'Set the object to nothing
Set objRequest = Nothing
End Sub
Sub Send_HTTP_RequestB()
'Force the script to finish on an error.
On Error Resume Next
'Declare variables
Dim objRequest
Dim URL
Set objRequest = CreateObject("Microsoft.XMLHTTP")
'Put together the URL link appending the Variables.
URL = "http://www.b.com/task.aspx?From=VPSScedule&ForceRun=True"
'Open the HTTP request and pass the URL to the objRequest object
objRequest.open "POST", URL , false
'Send the HTML Request
objRequest.Send
'Set the object to nothing
Set objRequest = Nothing
End Sub
Added Content
Thank you all! Is Code B correct?
Code B
Send_HTTP_Request "http://www.1.com/Task.aspx"
Send_HTTP_Request "http://www.2.com/task.aspx?From=VPSScedule&ForceRun=True"
Sub Send_HTTP_Request(URL)
On Error Resume Next
Dim objRequest
Set objRequest = CreateObject("Microsoft.XMLHTTP")
objRequest.open "POST", URL , false
objRequest.Send
Set objRequest = Nothing
End Sub
I use the following function to check if a RSS url is healthy then consume it:
function testUrl(url)
testUrl=0
Set o = CreateObject("MSXML2.XMLHTTP")
on error resume next
o.open "GET", url, false
o.send
if o.Status = 200 then testUrl = 1
on error goto 0
set o=nothing
end function
However when the target URL does not respond in a short time I will get timeout error. So I want to use the following function in this Q/A to terminate the request after 5 seconds if there was no success response but I dont know where to put the asp_Wait(5) and how to cancel the request after 5 seconds? Should I put asp_Wait right after the o.send or o.send acts synchronous?
Function asp_Wait(nMilliseconds)
Dim oShell
Set oShell= Server.CreateObject("WScript.Shell")
Call oShell.run("ping 1.1.1.1 -n 1 -w " & nMilliseconds,1,TRUE)
End Function
If using the WinHTTPRequest object you can call the WaitForResponse method.
Set o = CreateObject("MSXML2.XMLHTTP")
o.open "GET", url, true 'async request
o.send
If o.waitForResponse(5) Then 'wait 5 sec
...
Else 'wait timeout exceeded
...
End If
I use the following function to check if a URL responds in a few seconds:
function testUrl(url)
Set xmlDOM = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlDOM.Open "GET", url, False
xmlDOM.setTimeouts 1000,1000,1000,1000
testUrl=xmlDOM.Send
end function
if testUrl("http://khabarfoori.com/rss/mm") then
responsw.write "active"
else
response.write "inactive"
end if
Instead of getting "active" or "inactive" I get the following error:
> msxml6.dll error '80072ee2'
> The operation timed out
Footnote: The tested URL above buffers a big amount of text with no server error. Is it a special case and I need more code to handle this kind of response?
May be this can did the trick !
feed = "http://khabarfoori.com/rss/mm"
Set req = CreateObject("Msxml2.ServerXMLHTTP.6.0")
req.Open "GET", feed, False
req.Send
Set xml = CreateObject("Msxml2.DOMDocument")
xml.loadXml(req.responseText)
First_Title = xml.getElementsByTagName("channel/item/title")(0).Text
If Len(First_Title) <> 0 Then
MsgBox "active"
MsgBox First_Title
else
MsgBox"inactive"
End If
here is my code below , when i use it without proxy it runs smooth but when i start to use proxy the UI freezez for a bit , kindly tell me if their is something that can be done so it dont freeze and be able to do other stuff while its doing its thing.
Function httpreq(url As String) As String
Dim whr As New WinHttp.WinHttpRequest
Set whr = CreateObject("WinHttp.WinHttpRequest.5.1")
whr.Open "GET", url, False
whr.SetProxy 2, List1.Text, ""
whr.Send
httpreq = whr.ResponseText
RichTextBox1.Text = RichTextBox1.Text & whr.ResponseText
End Function
I'm writing a vbscript to pull some data from a webpage, strip out a few key pieces of information and write those to a file.
At the moment my script to access the pages and save the file contents to a string is this:
Set WshShell = WScript.CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
'Load Webpage where address is URL
http.open "GET", URL, FALSE
http.send ""
'Assign webpage contents as a string to variable called Webpage
WEBPAGE = http.responseText
I need to save the content to a string so I can use a regular expression on it to pull out the content that I need.
This script works perfectly, EXCEPT for when the pages contain non-standard characters (such as é). When the page contains something like this, the script throws up an error and stops.
I'm guessing this is something to do with the encoding, but I can't work out how to fix it. Can anyone point me in the right direction? Thanks guys
Edit
Thanks to the help here I realised I've asked the wrong question! It turns out I was downloading the content fine - the problem was, afterwards I was trying to edit it and write it out to a file, and the file was in the wrong format. I had this:
Set objTextFile = objFSO.OpenTextFile(OutputFile, 8, True,)
Changing it to this:
Set objTextFile = objFSO.OpenTextFile(OutputFile, 8, True, -1)
Seems to have fixed it. What a crazy world, eh? Thanks for the help.
You may need to set the correct header blocks before send
eg the following is an example only. You will need to find out what this is exactly for your website
http.open "GET", URL, FALSE
http.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
http.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
http.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
http.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
http.send ""
EDIT:
What about this instead. It works ok here
Dim XMLHttpReq,URL,WEBPAGE
Const Eacute = "%C3%89"
Set XMLHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
URL = "http://en.wikipedia.org/wiki/%C3%89"
'Load Webpage where address is URL
XMLHttpReq.Open "GET", URL, False
XMLHttpReq.send ""
'Assign webpage contents as a string to variable called Webpage
WEBPAGE = XMLHttpReq.responseText
WEBPAGE = Replace(WEBPAGE, Eacute, "É")
'Debug.Print WEBPAGE
The E acute in this case returns as string %C3%89 and you can force it to whatever character you choose if required.
EDIT2:
Just to add, if you're doing this with VBScript you may find this method useful
Dim XMLHttpReq, URL, WEBPAGE, fso, f
Const Eacute = "%C3%89"
Set XMLHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
URL = "http://en.wikipedia.org/wiki/%C3%89"
XMLHttpReq.Open "GET", URL, False
XMLHttpReq.send ""
WEBPAGE = XMLHttpReq.responseText
Save2File WEBPAGE, "C:\Users\osknows\Desktop\test.txt"
Sub Save2File (sText, sFile)
Dim oStream
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Open
.CharSet = "utf-8"
.WriteText sText
.SaveToFile sFile, 2
End With
Set oStream = Nothing
End Sub