Monitoring Services in Windows Servers via VBScript

Here is a script I wrote to monitor services in Windows Server which became very useful for my job.

If you want to use this script, don't forget the following things.

1. You need to supply a server name to this script as a parameter
2. You need to supply values for the following variables in the script manually
        - sFrom : From E-mail address, could be a fake address
        - sTo : who wants to receive alerts emails when the services isn't running. Multiple email addresses can be entered separated by semi-colon (NOT COMMA, remember this is Microsoft).
        - sSMTPServerName : A local SMTP server name

I wrote a batch file where I call this script with different server names like below,

CScript C:\Script\ServiceMon.vbs ServerName1
CScript C:\Script\ServiceMon.vbs ServerName2

You can copy and paste the script as below OR download it from HERE.

'******************************************************************************
' Name: ServiceMon.vbs
' Purpose: This script will check all the services on the specified server and send e-mail
' to specified e-mail addresses when services (set to Automatic start) is not running state
' You should be able to invoke this script via batch file and run it intervals to monitor the
' services on multple servers
' Parameter: ServerName
' E.g., CScript ServiceMon.vbs MySQLServer
' Written by: Anand Venkatachalapaty
'******************************************************************************
'On Error Resume Next

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

Dim MonitoredServer
Dim arrComputers
Dim StrComputer
Dim objItem, objWMIService, colItems
Dim sSubject, sMailText
Dim sFrom, sTo
Dim sSMTPServerName

MonitoredServer = WScript.Arguments(0)

'NOTE HERE...NOTE HERE...NOTE HERE
'Type the From and To Addresses here and SMTP server name
sFrom = MoniteredServer & "@mycompany.com"    'if you want, you can type any fake address here
sTo = "myself@company.com; sysadmins@company.com" 'multiple address sepearted by semi-colon
sSMTPServerName = "mail.company.com"

arrComputers = Array(MonitoredServer)
For Each strComputer In arrComputers

   Set objWMIService = GetObject("winmgmts:\\" & _
        strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM _
        Win32_Service", "WQL", _
        wbemFlagReturnImmediately + wbemFlagForwardOnly)

   For Each objItem In colItems

      If StrComp(objItem.State,"Running") <> 0 Then
        If StrComp(objItem.StartMode,"Auto") = 0 Then
            If StrComp(objItem.DisplayName,"Performance Logs and Alerts") = 0 Then
                'Skip it
            Else
                sSubject = UCase(MonitoredServer) & ": " & objItem.DisplayName  & " Service is " & UCase(objItem.State)
                sMailText = "Stopped Service Details on Server " & UCase(MonitoredServer) &  vbCrLf
                sMailText = sMailText & "Service Name: " & objItem.DisplayName & vbCrLf
                sMailText = sMailText & "Started: " & objItem.Started & vbCrLf
                sMailText = sMailText & "StartMode: " & objItem.StartMode & vbCrLf
                sMailText = sMailText & "State: " & objItem.State & vbCrLf
                sMailText = sMailText & "Status: " & objItem.Status & vbCrLf
                sMailText = sMailText & "ExitCode: " & objItem.ExitCode & vbCrLf
                sMailText = sMailText & "PathName: " & objItem.PathName & vbCrLf
                sMailText = sMailText & "ServiceSpecificExitCode: " & objItem.ServiceSpecificExitCode &vbCrLf
                InformAdmins sFrom,sTo,sSubject,sMailText,2
            End If
        End If
      End If
   Next
Next

Function WMIDateStringToDate(dtmDate)
    WScript.Echo dtm:
        WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
        Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
        & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function

'*******************************************************************************
'* Function Name: InformAdmins
'* Purpose: Send mail using CDO.Message object which works in Windows 2000/2003
'*          Servers.
'*
'* Sub Routine Arguments:
'*   "From address","To address","Subject", "Body Text","Prority"
'*
'* Importance argument should be 0 or 1 or 2.
'* 0 - Low Priority
'* 1 - Normal
'* 2 - High Priority
'*
'* Written Date: 5/7/04
'* Written By: Anand Venkatachalapathy
'*******************************************************************************

Sub InformAdmins(sFrom,sTo,sSubject,sBody,nPriority)
    DIM iMsg, Flds, iConf

    '* Assign cdoSendUsingPort is set to 2, i.e., send using SMTP (25) port
    Const cdoSendUsingPort = 2

    '* Create CDO Objects and assign to variables
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields

    '* Assign values to Flds class properties
    With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") _
                                     = cdoSendUsingPort
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                                     = sSMTPServerName
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout")_
                                 = 25 
    .Update
    End With

    '* Assign message properties and Send the mail
    With iMsg
       Set .Configuration = iConf
       .Fields("urn:schemas:httpmail:importance").Value = nPriority
       .Fields.Update
       .To = sTo
       .From = sFrom
       .Sender = sFrom
       .Subject = sSubject
       .TextBody = sBody
       .Send
    End With
End Sub
'*******************************************************************************
'* End of Script
'*******************************************************************************