Link to home
Start Free TrialLog in
Avatar of HopperSI
HopperSI

asked on

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

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

Avatar of purplepomegranite
purplepomegranite
Flag of United Kingdom of Great Britain and Northern Ireland image

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

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.
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

Avatar of HopperSI
HopperSI

ASKER

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?
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!
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.
ASKER CERTIFIED SOLUTION
Avatar of purplepomegranite
purplepomegranite
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
not helpful.  need simple cmd batch file