asked on

VB Script: ping servers and send notification if one of them is down

Hello experts,

I have multiple servers and I would like through VB script to check connectivity of each servers and send a notification e-mail if one of the server is down.

if possible (the priority is test connectivity) I would like to send a notification e-mail if Hard disk usage of one of the server is >%60

I have the notification script so I just need to include the test connectivity

' Send by connecting to port 25 of the SMTP server.
Dim iMsg 
Dim iConf 
Dim Flds 
Dim strHTML

Const cdoSendUsingPort = 2

set iMsg = CreateObject("CDO.Message")
set iConf = CreateObject("CDO.Configuration")

Set Flds = iConf.Fields


' Set the CDOSYS configuration fields to use port 25 on the SMTP server.

With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
    'ToDo: Enter name or IP address of remote SMTP server.
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "" 
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
    .Update
End With

' Build HTML for message body.
strHTML = "<HTML>"
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "<p>-----This message has been sent automatically-----<p>"
strHTML = strHTML & "<p>Regards,</p>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"

' Apply the settings to the message.
With iMsg
    Set .Configuration = iConf
    .To = "" 'ToDo: Enter a valid email address.
    .From = "" 'ToDo: Enter a valid email address.
    .Subject = ""
    .HTMLBody = strHTML
    .AddAttachment "c:\"
    .Send
End With

' Clean up variables.
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing

WScript.Quit

Open in new window

Thank you

perolin

Spiceworks or Paessler PRTG ... and the life is easier.
For free with so many monitoring.

Neil Russell

PRTG is only FREE for monitoring upto 30 sensors. But it will teach you what you are missing out on by not having it and playing with little unreliable scripts.

These tools exist for a reason, there is a HUGE demand for them. Why? Bwcause they do exactly what they are meant to.

zalazar

The following script can accomplish this.
Put the hostnames/FQDN's or IP-addresses in a file called PingComputers.txt, one entry per line.
I have merged your code with some small adjustments into the script.
Please modify the variables at the beginning of the script.

'*********************************************************************
'* Ping Computers and notify by e-mail
'*********************************************************************
Dim fso, objWMI, strScriptDir, strInput
Dim strEmailFrom, strEmailSubject, strEmailTo, strMessage, strSmtpServer

Set fso = CreateObject("Scripting.FileSystemObject")
Set objWMI = GetObject("winmgmts:\\.\root\cimv2")

' Modify these variables
strEmailFrom = "name1@email.com"
strEmailSubject = "Monitoring"
strEmailTo = "name2@email.com"
strSmtpServer = "smtp.email.com"

' Other variables
strMessage = ""
strScriptDir = Mid(Wscript.ScriptFullName, 1, InstrRev(Wscript.ScriptFullName, "\") - 1)
strInput = strScriptDir & "\PingComputers.txt"

call Main()
Wscript.Quit 0

'--------------------------------------------------------------------
' --------  SUBS / FUNCTIONS  --------
'--------------------------------------------------------------------
Sub Main()
  Dim fInput, sReadLine

  If fso.FileExists(strInput) = False Then
    Wscript.echo "ERROR|Can not find input file|" & strInput
    Exit Sub
  End If

  Set fInput = fso.OpenTextFile(strInput, 1)
  Do
    sReadLine = fInput.ReadLine
    If Left(sReadLine, 1) <> "#" And sReadLine <> "" Then
      PingComp(sReadLine)
    End If
  Loop While fInput.AtEndOfStream = False

  fInput.Close
  Set fInput = Nothing

  If strMessage <> "" Then
    ' Send e-mail
    call SendEmail(strMessage)
  End If
End Sub

Function PingComp(sComputer)
  Dim objPing, objStatus, sStatus

  strWMI = "Select * From Win32_PingStatus Where Address = '" & sComputer & "'"
  Set ObjPing = objWMI.ExecQuery(strWMI)

  On Error Resume Next
  For Each objStatus In objPing
    If IsNull(objStatus.StatusCode) Then
      Wscript.echo sComputer & "|Could not get a status"
      strMessage = strMessage & "<br>" & sComputer & "|Could not get a status"
    Else
      sStatus = LookupStatusCode(objStatus.StatusCode)
      If sStatus <> "REPLYED" Then
        Wscript.echo sComputer & "|" & sStatus
        strMessage = strMessage & "<br>" & sComputer & "|" & sStatus
      Else
        Wscript.echo sComputer & "|UP"
      End If
    End If
  Next
  On Error GoTo 0

  Set objPing = Nothing
End Function

Function LookupStatusCode(vCode)
  If vCode = 0 Then
    LookupStatusCode = "REPLYED"
  ElseIf VCode = 11001 Then
    LookupStatusCode = "Buffer Too Small"
  ElseIf VCode = 11002 Then
    LookupStatusCode = "Destination Net Unreachable"
  ElseIf VCode = 11003 Then
    LookupStatusCode = "Destination Host Unreachable"
  ElseIf VCode = 11004 Then
    LookupStatusCode = "Destination Protocol Unreachable"
  ElseIf VCode = 11005 Then
    LookupStatusCode = "Destination Port Unreachable"
  ElseIf VCode = 11006 Then
    LookupStatusCode = "No Resources"
  ElseIf VCode = 11007 Then
    LookupStatusCode = "Bad Option"
  ElseIf VCode = 11008 Then
    LookupStatusCode = "Hardware Error"
  ElseIf VCode = 11009 Then
    LookupStatusCode = "Packet Too Big"
  ElseIf VCode = 11010 Then
    LookupStatusCode = "Request Timed Out"
  ElseIf VCode = 11011 Then
    LookupStatusCode = "Bad Request"
  ElseIf VCode = 11012 Then
    LookupStatusCode = "Bad Route"
  ElseIf VCode = 11013 Then
    LookupStatusCode = "TimeToLive Expired Transit"
  ElseIf VCode = 11014 Then
    LookupStatusCode = "TimeToLive Expired Reassembly"
  ElseIf VCode = 11015 Then
    LookupStatusCode = "Parameter Problem"
  ElseIf VCode = 11016 Then
    LookupStatusCode = "Source Quench"
  ElseIf VCode = 11017 Then
    LookupStatusCode = "Option Too Big"
  ElseIf VCode = 11018 Then
    LookupStatusCode = "Bad Destination"
  ElseIf VCode = 11032 Then
    LookupStatusCode = "Negotiating IPSEC"
  ElseIf VCode = 11050 Then
    LookupStatusCode = "General Failure"
  Else
    LookupStatusCode = "Unknown"
  End If
End Function

Sub SendEmail(sMessage)
  ' Send by connecting to port 25 of the SMTP server.
  Dim iMsg, iConf, Flds, strHTML
  Const cdoSendUsingPort = 2

  Set iMsg = CreateObject("CDO.Message")
  Set iConf = CreateObject("CDO.Configuration")
  Set Flds = iConf.Fields

  ' Set the CDOSYS configuration fields to use port 25 on the SMTP server.
  With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
    .Update
  End With

  ' Build HTML for message body
  strHTML = "<HTML>"
  strHTML = strHTML & "<HEAD></HEAD>"
  strHTML = strHTML & "<BODY>"
  strHTML = strHTML & "<p>---- This message has been sent automatically ----<p>"
  strHTML = strHTML & "<p>" & sMessage & "</p>"
  strHTML = strHTML & "</BODY>"
  strHTML = strHTML & "</HTML>"

  ' Apply the settings to the message.
  Wscript.echo "Sending e-mail..."
  With iMsg
    .Configuration = iConf
    .From = strEmailFrom
    .To = strEmailTo
    .Subject = strEmailSubject
    .HTMLBody = strHTML
    .Send
  End With

  ' Clean up variables.
  Set iMsg = Nothing
  Set iConf = Nothing
  Set Flds = Nothing
End Sub

Open in new window

Luis Diaz

ASKER

@zalazar: thank you very much for this code, is there a way to complement this a script a log file, to identify if the servers are up or down?

ASKER CERTIFIED SOLUTION

zalazar

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

It works, thank you very much for your help!

zalazar

You're welcome and good to hear that it works fine.