Contact Info

Crumbtrail

ActiveXperts.com » Administration » VBScript » Network Monitor » Service

Service.vbs - Monitor a Windows service or multiple services using ActiveXperts Network Monitor

ActiveXperts Network Monitor ships with a powerful set of pre-defined checks. Each individual check has a static number of configuration items. To monitor other items, or to combine monitoring items, you can make use of custom VBScript checks.

Most of the built-in checks have a VBScript equivalent, implemented as a Function in a VBScript (.vbs) file. Out-of-the-box, each VBScript function monitors the same items as the built-in check. Feel free to modify a function. The VBScript check can be customized by editing the VBScript function.

To add a new VBScript-based service check, do the following:

To customize the above monitoring check, click on the 'Edit button' next to the 'File selection box'. Notepad will be launched. You can now make changes to the VBScript function(s).

Screenshot of a VBScript Service check

Service.vbs script source code

' ///////////////////////////////////////////////////////////////////////////////
' // ActiveXperts Network Monitor  - VBScript based checks
' // © ActiveXperts Software B.V.
' //
' // For more information about ActiveXperts Network Monitor and VBScript, please
' // visit the online ActiveXperts Network Monitor VBScript Guidelines at:
' //    https://www.activexperts.com/support/network-monitor/online/vbscript/
' // 
' ///////////////////////////////////////////////////////////////////////////////
'  

Option Explicit
Const  retvalUnknown = 1
Dim    SYSDATA, SYSEXPLANATION  ' Used by Network Monitor, don't change the names


' ///////////////////////////////////////////////////////////////////////////////

' // To test a function outside Network Monitor (e.g. using CSCRIPT from the
' // command line), remove the comment character (') in the following 5 lines:
' Dim bResult
' bResult =  CheckService( "localhost", "", "alerter" )
' WScript.Echo "Return value: [" & bResult & "]"
' WScript.Echo "SYSDATA: [" & SYSDATA & "]"
' WScript.Echo "SYSEXPLANATION: [" & SYSEXPLANATION & "]"

' //////////////////////////////////////////////////////////////////////////////

' //////////////////////////////////////////////////////////////////////////////

Function CheckService( strComputer, strCredentials, strService )

' Description: 
'     Checks if a service, specified by strService, is running on the machine specified by strComputer. 
' Parameters:
'     1) strComputer As String - Hostname or IP address of the computer you want to check
'     2) strCredentials As String - Specify an empty string to use Network Monitor service credentials.
'         To use alternate credentials, enter a server that is defined in Server Credentials table.
'         (To define Server Credentials, choose Tools->Options->Server Credentials)
'     3) strService As String - Name of the service
' Usage:
'     CheckService( "", "", "" )
' Sample:
'     CheckService( "localhost", "", "alerter" )

    Dim objWMIService

    CheckService      = retvalUnknown  ' Default return value
    SYSDATA           = ""             ' Not used in this function
    SYSEXPLANATION    = ""             ' Set initial value

    If( Not getWMIObject( strComputer, strCredentials, objWMIService, SYSEXPLANATION ) ) Then
        Exit Function
    End If

    CheckService      = checkServiceWMI( objWMIService, strComputer, strService, SYSEXPLANATION )

End Function

' //////////////////////////////////////////////////////////////////////////////

Function CheckMultipleServices( strComputerName, strCredentials, strServices )
' Description: 
'     Checks if a list of service, specified by strServices, is running on the machine specified by strComputer. 
' Parameters:
'     1) strComputer As String - Hostname or IP address of the computer you want to check
'     2) strCredentials As String - Specify an empty string to use Network Monitor service credentials.
'         To use alternate credentials, enter a server that is defined in Server Credentials table.
'         (To define Server Credentials, choose Tools->Options->Server Credentials)
'     3) strServices As String - List of services; the services are separated by the ';' character
' Usage:
'     CheckMultipleServices( "", "", "" )
' Sample:
'     CheckServices( "localhost", "", "alerter;messenger" )

    Dim strUnknownList, strErrorList, strSuccessList
    Dim arrServices, i
    Dim numResult, numTotalResult

    CheckMultipleServices  = True ' True, False or retvalUnknown
    numTotalResult         = True

    arrServices            = Split( strServices, ";" )

    For i = 0 To UBound( arrServices )
       numResult = CheckService( strComputerName, strCredentials, arrServices( i ) ) 
       If( numResult = True ) Then
          strSuccessList   = strSuccessList + " ["
          strSuccessList   = strSuccessList + arrServices( i )
         strSuccessList    = strSuccessList + "]"
       ElseIf( numResult = False ) Then
          strErrorList     = strErrorList + " ["
          strErrorList     = strErrorList + arrServices( i )
          strErrorList     = strErrorList + "]"
      Else
          strUnknownList   = strUnknownList + " ["
          strUnknownList   = strUnknownList + arrServices( i )
          strUnknownList   = strUnknownList + "]"
       End If
       
       If( numResult = True ) Then
         ' Nothing to do
       ElseIf( numResult = retvalUnknown ) Then
         If( numTotalResult <> False ) Then
           numTotalResult = numResult
         Else
           numTotalResult = False
         End If
       Else ' numResult   = False
         numTotalResult   = False
       End If
    Next
       
    If( numTotalResult = True ) Then
       SYSEXPLANATION     = "Following services are running: " & Trim( strSuccessList )
    ElseIf( numToTalResult = False ) Then
       SYSEXPLANATION     = "Following services are not running: " & Trim( strErrorList ) 
    Else
       SYSEXPLANATION     = "Following services have status unknown: " & Trim( strUnknownList ) 
    End If

    CheckMultipleServices = numTotalResult

End Function




' //////////////////////////////////////////////////////////////////////////////
' //
' // Private Functions
' //   NOTE: Private functions are used by the above functions, and will not
' //         be called directly by the ActiveXperts Network Monitor Service.
' //         Private function names start with a lower case character and will
' //         not be listed in the Network Monitor's function browser.
' //
' //////////////////////////////////////////////////////////////////////////////

Function checkServiceWMI( objWMIService, strComputer, strService, BYREF strSysExplanation )

    Dim colServices, objService

    checkServiceWMI             = retvalUnknown  ' Default return value

On Error Resume Next

    Set colServices = objWMIService.ExecQuery( "Select * from Win32_Service" )
    If( Err.Number <> 0 ) Then
        strSysData         = ""
        strSysExplanation  = "Unable to query WMI on computer [" & strComputer & "]"
        Exit Function
    End If
    If( colServices.Count <= 0  ) Then
        strSysData         = ""
        strSysExplanation  = "Win32_Service does not exist on computer [" & strComputer & "]"
        Exit Function
    End If

On Error Goto 0


    For Each objService In colServices
        If( Err.Number <> 0 ) Then
            checkServiceWMI     = retvalUnknown
            strSysExplanation   = "Unable to list services on computer [" & strComputer & "]"
            Exit Function 
        End If

        If( UCase( objService.Name ) = UCase( strService ) OR UCase( objService.DisplayName ) = UCase( strService ) ) Then
            If( objService.State <> "Running" ) Then
                checkServiceWMI = False
                strSysExplanation = "Service [" & objService.DisplayName & "] is " & objService.State
                Exit Function
            End If

            checkServiceWMI     = True
            strSysExplanation   = "Service [" & objService.DisplayName & "] is " & objService.State
            Exit Function			    
        End If
    Next

    checkServiceWMI             = retvalUnknown
    strSysExplanation           = "Service [" & strService & "] was not found on computer [" & strComputer & "]"
End Function

' //////////////////////////////////////////////////////////////////////////////

Function getWMIObject( strComputer, strCredentials, BYREF objWMIService, BYREF strSysExplanation )	

On Error Resume Next

    Dim objNMServerCredentials, objSWbemLocator, colItems
    Dim strUsername, strPassword

    getWMIObject              = False

    Set objWMIService         = Nothing
    
    If( strCredentials = "" ) Then	
        ' Connect to remote host on same domain using same security context
        Set objWMIService     = GetObject( "winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer &"\root\cimv2" )
    Else
        Set objNMServerCredentials = CreateObject( "ActiveXperts.NMServerCredentials" )

        strUsername           = objNMServerCredentials.GetLogin( strCredentials )
        strPassword           = objNMServerCredentials.GetPassword( strCredentials )

        If( strUsername = "" ) Then
            getWMIObject      = False
            strSysExplanation = "No alternate credentials defined for [" & strCredentials & "]. In the Manager application, select 'Options' from the 'Tools' menu and select the 'Server Credentials' tab to enter alternate credentials"
            Exit Function
        End If
	
        ' Connect to remote host using different security context and/or different domain 
        Set objSWbemLocator   = CreateObject( "WbemScripting.SWbemLocator" )
        Set objWMIService     = objSWbemLocator.ConnectServer( strComputer, "root\cimv2", strUsername, strPassword )

        If( Err.Number <> 0 ) Then
            objWMIService     = Nothing
            getWMIObject      = False
            strSysExplanation = "Unable to access [" & strComputer & "]. Possible reasons: WMI not running on the remote server, Windows firewall is blocking WMI calls, insufficient rights, or remote server down"
            Exit Function
        End If

        objWMIService.Security_.ImpersonationLevel = 3

    End If
	
    If( Err.Number <> 0 ) Then
        objWMIService         = Nothing
        getWMIObject          = False
        strSysExplanation     = "Unable to access '" & strComputer & "'. Possible reasons: no WMI installed on the remote server, no rights to access remote WMI service, or remote server down"
        Exit Function
    End If    

    getWMIObject              = True 

End Function