VB6 - WinHttpRequest Timouts Problem - vb6

I'm using a WebRequest in VB6 and I have the timeouts set at "5000" (5 seconds), but even after 5 seconds it is not timing out, any help is appreciated.
x:
Dim objWinHTTP
Set objWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHTTP.Open "POST", "http://twitter.com/" & TwitterUSERNAME
objWinHTTP.SetTimeouts 5000, 5000, 5000, 5000
Call objWinHTTP.Send(psData)
MsgBox (objWinHTTP.Status)
If objWinHTTP.Status <> 200 Then
Timer.Enabled = False
MsgBox ("D:")
GoTo x
End If

you should set objWinHTTP.SetTimeouts before objWinHTTP.Open
and the four parameters you set for objWinHTTP.SetTimeouts are
Resolve, Connect, Send and Receive
So each value should be set according to that.

Related

Where to put the sleep function in MSXML request?

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

Sending GET requests in VBScript loop fails

I'm setting up a client code written VBScript which probes a text file on a server with HTTP GET requests. The client has actions related to each HTTP response text.
While doing so in a While True loop, the first request returns the correct value. All the preceding requests return the same value the first response did.
The content of the file changes while the HTTP request doesn't seem to leave the client while sniffing packets.
Code:
function checkLog(url)
Dim WshShell, http
Set WshShell = CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
On Error Resume Next
http.open "GET" , url, False
http.send ""
checkLog = http.responseText
End function
Dim lastVal = "2"
Dim logResult = "2"
Do While True
logResult = checkLog("http://10.0.0.3/log.txt")
If logResult <> lastVal Then
If logResult = "0" Then
' Go Func 1
MsgBox "Got 0"
lastVal = logResult
End If
If logResult = "1" Then
' Go Func 2
MsgBox "Got 1"
lastVal = logResult
End If
End If
Sleep 5
LOOP
I expect that a packet will be sent every 5 seconds.
Thanks!
Disable caching of the HTTP response.
Set req = CreateObject("Msxml2.XmlHttp")
On Error Resume Next
req.Open "GET", url, False
req.SetRequestHeader "Cache-Control", "no-cache"
req.Send ""
checkLog = req.ResponseText

Check network connection with VBScript

I'm running a web-based slideshow on multiple computer units. I have a VBScript that runs on startup, opens IE and navigates to a specific page in fullscreen mode. Everything works great, as long as there's an internet connection on startup. If there isn't then the page never loads. Is there a way in VBScript to check for a connection every couple minutes until the connection is found, and then continue with the script? Here is the code for your reference:
Option Explicit
Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
With WScript.CreateObject ("InternetExplorer.Application")
.Navigate "http://www.example.com/slideshow"
.fullscreen = 1
.Visible = 1
WScript.Sleep 10000
End With
On Error Goto 0
Refer to this ==> Loop a function?
Yes, you can do it easily with this code :
Option Explicit
Dim MyLoop,strComputer,objPing,objStatus
MyLoop = True
While MyLoop = True
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
Call MyProgram()
wscript.quit
End If
Next
Pause(10) 'To sleep for 10 secondes
Wend
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub MyProgram()
Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
With WScript.CreateObject ("InternetExplorer.Application")
.Navigate "http://www.example.com/slideshow"
.fullscreen = 1
.Visible = 1
WScript.Sleep 10000
End With
On Error Goto 0
End Sub
'**********************************************************************************************
If Hackoo's code doesn't work for you, you can try the following. Not all servers will respond to ping requests but you could just make an HTTP request and see if the server sends a valid response (status = 200).
Function IsSiteReady(strURL)
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", strURL, False
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1)"
On Error Resume Next
.Send
If .Status = 200 Then IsSiteReady = True
End With
End Function

WinHttpRequest ResponseText getting Empty for text(.txt) file - Windows2008R2/ Windows 7

I'm new to QTP and VBScript and I'm trying to get the text file content as a response(sample URL : http://x.x.x.x/dir/MIS/test_667/logfile.667.txt). The below code is working as required on WindowsXP, but getting 'Empty' ResponseText( sIMPResponse = objWinHTTP.ResponseText) on Windows7/Windows2008R2.
I tried with different User-Agent strings # http://www.zytrax.com/tech/web/msie-history.html , but no luck.
Can anyone please assist on the solution to get the .txt file content for WinHTTP.ResponseText.
Thanks in advance for your help.
CodeSnippet:
Dim sResponse, sIMPResponse
Function PortalUrlExists(ByVal sUrl)
On Error Resume Next
UrlExists = False
Dim objWinHTTP, nStatus
'Create a WinHTTP Request using the link's URL
Set objWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
If Err.Number <> 0 Then
Exit Function
End If
objWinHTTP.Open "GET", sUrl, False
objWinHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
'Send the Request to the Server and capture the response
objWinHTTP.SetTimeouts 180000, 180000, 180000, 180000
objWinHTTP.Send
If Err.Number <> 0 Then
Set objWinHTTP = Nothing
Exit Function
End If
nStatus = objWinHTTP.Status
If nStatus = 200 Then
UrlExists = True
If InStr(1, sUrl, ".txt", vbTextCompare) > 0 Then
sIMPResponse = objWinHTTP.ResponseText ' ***** This is getting "Empty", where as it has to get the text file content from the URL ****
Else sResponse = objWinHTTP.ResponseText
End If
End If
Set objWinHTTP = Nothing
End Function

Timeout for a HTTP Resquest

Is there another ProgID instead of "MSXML2.XMLHTTP" that lets you set a timeout in VBScript?
OnReadyStateChange or similar must also work in VBScript.
Set oHTTP = CreateObject("MSXML2.XMLHTTP")
oHTTP.timeout = 10000 'Throws an error
oHTTP.Open "GET", "http://www.google.com", True
oHTTP.OnReadyStateChange = GetRef("oHTTP_OnReadyStateChange")
Sub oHTTP_OnReadyStateChange
' do something
End sub
oHTTP.Send
You can use either ServerXmlHttp with setTimeouts, or just use windows.XMLHttpRequest instead.

Resources