?
Solved

Script to ping an IP and send an email when ping returns consecutive timeouts or high timeout

Posted on 2008-06-26
8
Medium Priority
?
13,103 Views
Last Modified: 2010-12-06
I would like a vbscript to ping an IP at certain time intervals (seconds ideally) and email me if the pings timeout. So far I have gotten the following code which runs the windows ping.exe, but the script completes and sends an email before the ping times out. The problem is in the switch I have on the ping command as you'll see below.

 I am using this to ping a router on the other side of a VPN, so I will receive an email when the VPN disconnects.  A combination vbscript and batch file would work as well.
Rem Runs Ping command, outputs results to text file.
 
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
strComputer = "."
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
    ("Select * From Win32_LogicalDisk Where DriveType = 3")
 
For Each objItem in colItems
    strDriveLetter = objItem.DeviceID 
    strCommand = "ping 192.xxx.x.xxx -w 999"
    
    Set objExecObject = objShell.Exec(strCommand)
    Do While Not objExecObject.StdOut.AtEndOfStream
        strResults = objExecObject.StdOut.ReadAll()
    Loop
 
    strText = strText & strResults
Next
 
Rem Sends email alert
 
Set objFile = objFSO.CreateTextFile("C:\PingFailed.txt")
objFile.Write strText
objFile.Close
 
Set objEmail = CreateObject("CDO.Message")
 
objEmail.From = "VPN_Dissconnect@domain.com"
objEmail.To = "admin@domain.com"
objEmail.Subject = "VPN from office to RemoteSite just disconnected" 
objEmail.Textbody = "The ping time from the Office to RemoteSite was just over 999ms, indicating the VPN probably disconnected." & strDate
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
        "SMTP_server_name" 
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
 
Rem Renames text file with time and date

Open in new window

0
Comment
Question by:HopperSI
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
8 Comments
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21878651
The attached will ping until a Request Timed Out is shown in the ping command.
Rem Runs Ping command, outputs results to text file.
 
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
strComputer = "."
 
strCommand = "ping 192.xxx.x.xxx -w 999"
strResults=""
while not InStr(1,StrResults,"Request timed out")>0
	Set objExecObject = objShell.Exec(strCommand)
	Do While Not objExecObject.StdOut.AtEndOfStream
		strResults = objExecObject.StdOut.ReadAll()
	Loop
wend
 
strText = strText & strResults
 
Rem Sends email alert
 
Set objFile = objFSO.CreateTextFile("C:\PingFailed.txt")
objFile.Write strText
objFile.Close
 
Set objEmail = CreateObject("CDO.Message")
 
objEmail.From = "VPN_Dissconnect@domain.com"
objEmail.To = "admin@domain.com"
objEmail.Subject = "VPN from office to RemoteSite just disconnected" 
objEmail.Textbody = "The ping time from the Office to RemoteSite was just over 999ms, indicating the VPN probably disconnected." & strDate
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
        "SMTP_server_name" 
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
 
Rem Renames text file with time and date

Open in new window

0
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21878657
By the way, I am not sure what the WMI calls were doing in your original script.  They weren't needed at all for the ping (you were querying the logical drives on the system?), so I have removed them from the adapted script.
0
 
LVL 15

Expert Comment

by:sr75
ID: 21878662
Here is my script that I use to ping a list of servers.  It can be modified to just ping one IP address.  It will send an email every 30 minutes until the ping is successful.  It also creates a log.  As far as your script.  You should get rid of the "do while not" loop because the scripting host will wait for the objshell.exec to finish before continuing on.  Atleast it does in my script.
'########################################################################################
'#											#
'#	Name:		PingServers.vbs							#
'#	Version:	1.1.0								#
'#	Created:	August 3rd, 2007						#
'#	Modified:	August 20th, 2007						#
'#	Author:		Martin Roeske							#
'#											#
'#	Description:	This script will test connectivity to an array of servers and 	#
'#			send a notification when a server is unreachable.		#
'#											#
'#	Notes:		This script uses PING to test for connectivity.  It will also 	#
'#			log any failures and create a "cookie" so that the email 	#
'#			notifications are only sent every 15 minutes or so.  When a  	#
'#			failure does occur, the script will wait 15 seconds before 	#
'#			making a second attempt.  If that fails, then a notification 	#
'#			will be sent.							#
'#											#
'#				Sub Function		Description			#
'#			---------------------------------------------------------------	#
'#			func_ReadFile()		This function will read a text file and	#
'#						fill an array with each line from the 	#
'#						file becoming an element of the array.	#
'#											#
'#			ping()			This function will Ping a computer and 	#
'#						output a TRUE for a successful ping, or #
'#						FALSE for after two failures.		#
'#											#
'#			func_Cookie()		This function will create a "cookie" 	#
'#						if the ping connectivity test fails. It #
'#						will also check the cookie so that a 	#
'#						notification is sent every 15 minutes.	#
'#											#
'#			func_Log()		This function will write the product	#
'#						information to a network share. It will #
'#						also rotate out any data that is older 	#
'#						than 90 days.				#
'#											#
'#			func_TimeStamp()	This function will generate a timestamp	#
'#						in this format:  YYYYMMDD HH:MM:SS AM	#
'#											#
'#			func_Notify()		This function will send an notification	#
'#						via email stating that the server has	#
'#						failed its test.			#
'#											#
'########################################################################################
'---------------------------------------------------------------------------
'
'				Main Function
'
'---------------------------------------------------------------------------
Option Explicit
 
DIM FSO
DIM SrvFile
DIM arrServers
DIM Server
DIM TimeStamp
 
set FSO = CreateObject("Scripting.FileSystemObject")
 
SrvFile = "Servers.txt"
 
arrServers = func_ReadFile(SrvFile)
 
For Each Server in arrServers
	If ping(Server) = FALSE then
		TimeStamp = func_TimeStamp()
		func_Log TimeStamp,Server
	End If
Next
 
set FSO = Nothing
set SrvFile = Nothing
set arrServers = Nothing
set Server = Nothing
set TimeStamp = Nothing
 
wscript.quit
 
 
'---------------------------------------------------------------------------
'
'				Sub Functions
'
'---------------------------------------------------------------------------
 
Function func_ReadFile(strFile)
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	'
	'  This function will read a file and generate an array 
	'  with each element being a line from the file
	'
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
	DIM rFile
	DIM rLine
	DIM arrFile
 
	set rFile = FSO.OpenTextFile(strFile)
 
	Do until rFile.AtEndOfStream
		rLine = rFile.ReadLine
		if rLine <> "" then
			arrFile = arrFile & rLine & ";"
		End If
	Loop
 
	rfile.Close
 
	arrFile = ucase(arrFile)
	arrFile = Left(arrFile, len(arrFile) -1)
	arrFile = split(arrFile, ";")
 
	func_ReadFile = arrFile
 
	set rFile = Nothing
	set rLine = Nothing
	set arrFile = Nothing
 
End Function
 
Function ping(Server)
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	'
	'  This function will Ping a computer and output a TRUE 
	'  for a successful ping, or FALSE for after two failures.
	'
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
	DIM WShell,objExec,strPingResults
 
 
	set WShell = CreateObject("WScript.Shell")
	set objExec = WShell.Exec("ping -n 2 -w 1000 " & Server)
	strPingResults = LCase(objExec.StdOut.ReadAll)
	If InStr(strPingResults, "reply from") then
		ping = TRUE
	else
		wscript.sleep 15000
	
		set objExec = WShell.Exec("ping -n 2 -w 1000 " & Server)
		strPingResults = LCase(objExec.StdOut.ReadAll)
		If InStr(strPingResults, "reply from") then
			ping = TRUE
		else
			
			ping = FALSE
		End If
	End If
	
	set WShell = Nothing
	set objExec = Nothing
	set strPingResults = Nothing
 
End Function
 
 
Function func_Cookie(Server, test)
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	'
	'  This function will create a "cookie" should the ping 
	'  test fail for the server.  It will also check the 
	'  cookie so that a notification is sent every 15 minutes.
	' 
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
	DIM strCFold,strCook,blCookie
	DIM rFile,rLine,rDate,cFile,nTime
 
	strCFold = "\\Servers\Result$\Cookies\"
	strCook = strCFold & "Ping_" & Server & ".Cookie"
 
	If FSO.FileExists(strCook) then
		Set rFile = FSO.OpenTextFile(strCook)
	
		Do Until rFile.AtEndOfStream
			rLine = rFile.ReadLine
			If rLine <> "" then
				rDate = CDate(split(rLine, vbtab)(0))
				nTime = Now()
				If DateDiff("N", rDate, nTime) < 15 then
					blCookie = FALSE
				Else
					blCookie = TRUE
				End If
			End If
		Loop
	Else
		blCookie = TRUE
	End If
 
	If blCookie = TRUE then
		set cFile = FSO.OpenTextFile(strCook, 2, True)
		cFile.Write func_TimeStamp() & vbtab & Server
		cFile.close
		func_Cookie = TRUE
	Else
		func_Cookie = FALSE
	End If		
 
	set strCFold = Nothing
	set strCook = Nothing
	set blCookie = Nothing
	set rFile = Nothing
	set rLine = Nothing
	set rDate = Nothing
	set cFile = Nothing
	set nTime = Nothing
		
End Function
 
 
Function func_Log(TimeStamp,Server)
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	'
	'  This function will Log the failed pings to a file on 
	'  the network.  It will also check to ensure the data is
	'  not duplicated in the log.
	'
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
	DIM strFold,strFile,blTest,wFile
	DIM rFile,rLine,rLog,rDate,nTime
 
	strFold = "\\Server\Result$"
	strFile = strFold & "\Server_Ping.Log"
 
	If FSO.FileExists(strFile) then
		Set rFile = FSO.OpenTextFile(strFile)
 
		Do Until rFile.AtEndOfStream
			rLine = rFile.ReadLine
			If rLine <> "" then
				rDate = CDate(split(rLine, vbtab)(0))
				nTime = Now()
				If DateDiff("D", rDate, nTime) < 90 then
					rLog = rLog & rLine & vbcrlf
				End If
			End If
		Loop
		rFile.close
	End If 
 
	blTest = func_Cookie(Server,rLog)
 
	set wFile = FSO.OpenTextFile(strFile, 2, True)
	wFile.write TimeStamp & vbtab & Server & vbtab & "PING failure" & vbcrlf
 
	If blTest = TRUE then
		wFile.Write TimeStamp & vbTab & Server & vbTab & "**** Email Sent ****" & vbcrlf 
		func_Notify(Server)
	End If
 
	wFile.Write rLog
	wFile.Close 
 
	set strFold = Nothing
	set strFile = Nothing
	set blTest = Nothing
	set wFile = Nothing
	set rFile = Nothing
	set rLine = Nothing
	set rLog = Nothing
	set rDate = Nothing
	set nTime = Nothing
 
End Function
 
 
Function func_TimeStamp()
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	'
	'  This function will generate a timestamp in this format:
	'
	'	YYYYMMDD HH:MM:SS AM/PM
	'
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
	DIM strYear
	DIM strMonth
	DIM strDay
	DIM strTime
	DIM strStamp
 
	strYear = Year(Now)
	strMonth = Month(Now)
	strDay = Day(Now)
	strTime = Time()
	If len(strMonth) < 2 then
		strMonth = "0" & strMonth
	End If
	If len(strDay) < 2 then
		strDay = "0" & strDay
	End If
	
	strStamp = strYear & "-" & strMonth & "-" & strDay & " " & strTime
 
	if len(strStamp) <> 22 then
		Do Until len(strStamp) > 21
			strStamp = strStamp & " "
		Loop
	end If
		
	func_TimeStamp = strStamp
 
	set strYear = Nothing
	set strMonth = Nothing
	set strDay = Nothing
	set strTime = Nothing
	set strStamp = Nothing
 
End Function
 
 
Function func_Notify(Server)	
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	'
	'  This function will send an email notification stating 
	'  that Server has failed it's ping test.
	'
	'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
	DIM strName,strRecip,strSubject,strMsg
	DIM strSrv,strSend,strServer,strPort
	DIM Msg
 
 
	strName = "PingFailure@domain.com"		'Sender's Email
	strSrv = "smtp.domain.com"       		'SMTP Server
	strSubject = Server & "-- FAILED PING!!!"	'Email Subject
	strRecip = "recipient@domainc.om"		'Recipient's Email
 
	strMsg = "Failed to ping " & ucase(Server) & " at " & Now()
 
	strSend = "http://schemas.microsoft.com/cdo/configuration/sendusing"
	strServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
	strPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
	
	Set Msg = CreateObject("CDO.Message")
	Msg.Configuration.Fields.Item(strSend) = 2
	Msg.Configuration.Fields.Item(strServer) = strSrv
	Msg.Configuration.Fields.Item(strPort) = 25
	Msg.Configuration.Fields.Update
 
	Msg.Subject = strSubject
	Msg.From = strName
	Msg.To = strRecip
	Msg.TextBody = strMsg
	Msg.Send
 
	set strName = Nothing
	set strRecip = Nothing
	set strSubject = Nothing
	set strMsg = Nothing
	set strSrv = Nothing
	set strSend = Nothing
	set strServer = Nothing
	set strPort = Nothing
	set Msg = Nothing
 
End Function

Open in new window

0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:HopperSI
ID: 21878732
purplepomegranite that was perfect.  Points will be awarded. (No logical disk querying was needed)

 If I wanted to take it one step further and run that ping every 30 seconds, or every minute (to reduce network traffic), what would need to be modified?
0
 
LVL 9

Expert Comment

by:gregcmcse
ID: 21878746
I don't know if the problem is with the ping command... although your IP address should be last in the code.  I have code that does virtually this exact same thing.  This code works for me (I've changed it to use your variable names):

Set objExecObject = objShell.Exec("ping -w 999 192.xxx.x.xxx")
Set oTempFile = objExecObject.StdOut
strResults = ""
Do While Not oTempFile.AtEndOfStream
      strResults = strResults & Trim(oTempFile.ReadLine)
Loop

I'm thinking either your ping syntax being off was causing the problem (seems unlikely) or the ReadAll is causing a premature detection of "AtEndOfStream".

Hope this helps!
0
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21878990
I can adapt it to run  ping every thirty seconds until unsuccessful.  It basically involves modifying the ping command (presumably only one ping is necessary) and adding a wscript.sleep command to wait before doing the next one.

Will add this shortly.
0
 
LVL 24

Accepted Solution

by:
purplepomegranite earned 1000 total points
ID: 21879020
Attached should do it.

When you first run the script, it will sleep straight away for thirty seconds, then start pinging every 30 seconds.  Easiest way for me to incorporate it, and my reasoning is also that you would start the script once VPN established, so it shouldn't need to ping for the first 30 seconds.
Rem Runs Ping command, outputs results to text file.
 
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
strComputer = "."
 
strCommand = "ping -n 1  -w 999 192.xxx.x.xxx"
strResults=""
while not InStr(1,StrResults,"Request timed out")>0
	wscript.sleep 30000 ' Sleep for thirty seconds - when the script is first run, no ping for first thirty seconds
	Set objExecObject = objShell.Exec(strCommand)
	Do While Not objExecObject.StdOut.AtEndOfStream
		strResults = objExecObject.StdOut.ReadAll()
	Loop
wend
 
strText = strText & strResults
 
Rem Sends email alert
 
Set objFile = objFSO.CreateTextFile("C:\PingFailed.txt")
objFile.Write strText
objFile.Close
 
Set objEmail = CreateObject("CDO.Message")
 
objEmail.From = "VPN_Dissconnect@domain.com"
objEmail.To = "admin@domain.com"
objEmail.Subject = "VPN from office to RemoteSite just disconnected" 
objEmail.Textbody = "The ping time from the Office to RemoteSite was just over 999ms, indicating the VPN probably disconnected." & strDate
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
        "SMTP_server_name" 
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
 
Rem Renames text file with time and date

Open in new window

0
 

Expert Comment

by:profiletech
ID: 25101430
not helpful.  need simple cmd batch file
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

AutoHotkey is an excellent, free, open source programming/scripting language for Windows. It started out as a keyboard/mouse macros product, but has expanded into a robust language. This article provides an introduction to it, with links to addition…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Michael from AdRem Software outlines event notifications and Automatic Corrective Actions in network monitoring. Automatic Corrective Actions are scripts, which can automatically run upon discovery of a certain undesirable condition in your network.…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Suggested Courses
Course of the Month13 days, 1 hour left to enroll

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question