×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBScript FAQ

Systems Monitoring (vbs/mom)

Server Monitoring by eraH
Posted: 19 May 09 (Edited 12 Jun 12)

This script will monitor a list of server for availability (with ping), check disk space, and check services. If a problem is found, it will display a message or email depending on which option you choose.
How to use:
Copy the script to a folder, create two files, one called ServerList.txt and one called ExcludedServices.txt.
Add your servers into ServerList.txt one line at a time.
Add your list of services not to monitor into ExcludedServices.txt one line at a time, you will probably want to add 'Performance Logs and Alerts' in from the start.

CODE

'=======================================
'Configure Script
'0.500 is 500MB
FreeSpaceSize = 0.500
'600000 = 60 seconds, how often the check is run
RepeatInterval = 600000
'This can be Console or Email
AlertType = "Console"
'Email From
EmailFrom = "ServerMonitoring@mydomain.com"
'Email To
EmailTo = "me@mydomain.com"
'Email Server
EmailServer = "myemailserver"

'=======================================

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")

'Check that ServerList.txt exists
If Not objFSO.FileExists("ServerList.txt") Then
WScript.Echo "File ServerList.txt Doesn't Exist. Create file ServerList.txt in same folder as script."
WScript.Echo "Add server names to this file, each on it's own line."
WScript.Quit
End If

'Check that ExcludedServices.txt exists
If Not objFSO.FileExists("ExcludedServices.txt") Then
WScript.Echo "File ExcludedServices.txt Doesn't Exist. Create file ExcludedServices.txt in same folder as script."
WScript.Echo "Add services to this file, each on it's own line."
WScript.Quit
End If

Set objFileServers = objFSO.OpenTextFile("ServerList.txt", 1)
Set objFileExcludedServices = objFSO.OpenTextFile("ExcludedServices.txt", 1)

'Read files into arrays
ServersArray = Split (objFileServers.ReadAll, vbNewLine)
ServicesArray = Split (objFileExcludedServices.ReadAll, vbNewLine)
For Each strService In ServicesArray
objDictionary.Add strService, strService
Next

objFileServers.Close()
objFileExcludedServices.Close()

'Loop Forever
LoopValue = 0
Do Until LoopValue = 1
For Each strServer in ServersArray
'Checks if server is up
If Ping(strServer) = True Then
'Checks disk space
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk Where DriveType = 3 ")
For Each objDisk in colDisks
If FormatNumber (intFreeSpace /1024/1024/1024 ,2) < FreeSpaceSize Then
Alert("Disk")
End If
Next
'Checks services
Set colRunningServices = objWMIService.ExecQuery("Select * from Win32_Service")
For Each objService in colRunningServices
If objService.State = "Stopped" And objService.StartMode = "Auto" And Not objDictionary.Exists(objService.DisplayName) Then
Alert("Service")
End If
Next
Else
Alert("ServerDown")
End If
Next
WScript.Sleep (RepeatInterval)
Loop

Function Ping(strHost)
Dim objPing, objRetStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("Select * from Win32_PingStatus Where Address = '" & strHost & "'")

For Each objRetStatus In objPing
If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode<>0 Then
Ping = False
Else
Ping = True
End If
Next
End Function

Sub Alert(strAlert)
Set objEmail = CreateObject("CDO.Message")
objEmail.From = EmailFrom
objEmail.To = EmailTo
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = EmailServer
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Fields.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High"
objEmail.Fields.Item("urn:schemas:mailheader:X-Priority") = 2
objEmail.Fields.Item("urn:schemas:httpmail:importance") = 2
objEmail.Fields.Update
If AlertType = "Console" Then
If strAlert = "Disk" Then
WScript.Echo "Disk " & objDisk.DeviceID & " on server " & Ucase(strServer) & " has " & Formatnumber(objDisk.Freespace / 1024/1024/1024 ,2) & " GB free space"
End If
If strAlert = "Service" Then
WScript.Echo objService.DisplayName & " on server " & Ucase(strServer) & " has stopped."
End If
If strAlert = "ServerDown" Then
WScript.Echo Ucase(strServer) & " is down."
End If
End If
If AlertType = "Email" Then
If strAlert = "Disk" Then
objEmail.Subject = "Low disk space"
objEmail.TextBody = "Disk " & objDisk.DeviceID & " on server " & Ucase(strServer) & " has " & Formatnumber(objDisk.Freespace / 1024/1024/1024 ,2) & " GB free space"
objEmail.Send
End If
If strAlert = "Service" Then
objEmail.Subject = "Service has stopped"
objEmail.TextBody = objService.DisplayName & " on server " & Ucase(strServer) & " has stopped."
objEmail.Send
End If
If strAlert = "ServerDown" Then
objEmail.Subject = "Service is down"
objEmail.TextBody = Ucase(strServer) & " is down."
objEmail.Send
End If

End If
End Sub

Back to VBScript FAQ Index
Back to VBScript Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close