Question : Problem: Applet to Prevent VPN Timeouts

I have a couple clients with whom I have VPN accounts where the VPN servers are configured with short timeout periods. (5 minutes, I believe.) If I'm using VPN, and I hop over to a local application even for a brief period of time, I get a timeout. To reestablish my work on the client server, I typically have to logon via VPN and then logon via RD as well. It's a pain. Is there a little applet out there (or even a BAT script, VBS script, or a VB.NET piece of code) that would maintain a minimal level of activity through the VPN tunnel that would prevent these timeouts?

Answer : Problem: Applet to Prevent VPN Timeouts

The attached code will ping until the first unsuccessful ping (or you stop the script with ). Just change the parts I've commented. It outputs the result to the command window.

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:



Option Explicit
dim blnPinged, strHost
strHost="www.google.com"  ' Change the address to where you want to ping
blnPinged=true
 
while blnPinged ' Loop while ping is successful
	blnPinged=Ping(strHost)
	if blnPinged then
		wscript.echo "Pinged " & strHost & " successfully at " & Now
		WScript.Sleep 1000 ' 1000 is one second, adjust accordingly
	else
		wscript.echo "Ping failed to " & strHost & " at " & Now
	end if
wend
 
 
Function Ping(strHost)
	dim objPing, objRetStatus
	set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
	("select * from Win32_PingStatus where address = '" & strHost & "'")
 
	for each objRetStatus in objPing
		if IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode<>0 then
			Ping = False
		else
			Ping = True
		end if
	next
End Function

Open in New Window Select All