[windows2000] System Monitoring using WSH, WMI, Ping and a SMS Broadcaster

  • From: Spriggs Jon <Jon.Spriggs@xxxxxxxxxxxxxx>
  • To: thin@xxxxxxxxxxxxx, windows2000@xxxxxxxxxxxxx, windowsxp@xxxxxxxxxxxxx
  • Date: Fri, 8 Oct 2004 16:27:54 +0100

Hi all,

A while back I posted to this list asking for advice on how to solve a fault
with a script I was writing.

Well, I think I've got it sussed now, and I'm releasing version 0.3, and I
thought the best place to release it was to here :)

In order to make this script run, create a file in C:\ called Servers.csv -
this file should only contain the names of the servers you want the script
to run against.

Then, put this file anywhere on your system and set it to run in your
scheduled tasks. One-off running can be done, just by calling cscript
pingserver.vbs. If you want to see where it's failing on (if it is at all)
just append /d or -d on the command line to get the "debug view".

This code isn't the cleanest ever, so, if anyone wants to adjust the code,
drop me a line and I'll make the changes.

Oh yes, and if you want it to broadcast using your own SMS server, change
the code in the last sub from 
        objShell.Run "NotifyLite.exe [NLITEG1] " & txtSendText 
to 
        objShell.Run "myprog.exe " & txtSendText

Where myprog.exe is the name of your SMS or Pager application

Thanks,

Jon Spriggs
-- 
The presence of a "Fujitsu" address does not imply or assume that Fujitsu
Services, Fujitsu or any other company containing the Fujitsu name uses or
endorses this product. This email is purely a personal opinion.

' PingServer.vbs
' ------------------------
' - Super Server Checker -
' ------------------------
'
' Version: 0.1 05/10/04 Released by Jon Spriggs
' Notes: First version, submitted to [ t h i n AT f r e e l i s t s DOT o r
g ] and 
' [ w i n d o w s 2 0 0 0 AT f r e e l i s t s DOT o r g ]
'
' Version: 0.1a 06/10/04 Released by Jon Spriggs
' Notes: Version with changes suggested by Spencer Sun and Glenn Sullivan.
Improvements in code and
' major commenting!
'
' Version: 0.2 08/10/04 Released by Jon Spriggs
' Notes: Now checks hard disks on servers in the servers list. Implemented a
change suggested by
' Colin Howell to allow debugging via a /D switch. Tried to use Option
Explicit (as suggested on
' of the d-lists I posted to in version 0.1, but this broke more than it
solved. I've made a few
' changes to the code in response (mainly checking array sizes), so now it's
a bit more accurate.
' This code also contains "Disk" space limits. It's currently set to 3% as
Critical and 10% as
' warning. Search for a line "If varDP < 10 Then" and "If varDP < 3 Then" if
you want to change 
' these.
'
' Version: 0.3 08/10/04 Released by Jon Spriggs
' Changed the code which checks Services to a function. This resulted in
breakages in the code
' which chooses the broadcast message. This code was moved into a sub.
'
' Licence: Some code belongs to other people and is credited where due.
Otherwise, consider this 
' text freeware, but copyright owned by Jon Spriggs. If you want to make any
changes, and want 
' these to be reflected in the code, e-mail 
' [ j o n DOT s p r i g g s AT u k DOT f u j i t s u DOT c o m ]
' with the change.

Option Explicit

On Error Resume Next

public Sub subDebug(txtDebug)

' In theory, this should allow you to do /D at the end of the script to make
it do debuging. Thanks
' Colin Howell.

        If Wscript.Arguments.Count >0 Then
                if Ucase(Wscript.Arguments(0)) = "/D" OR
Ucase(Wscript.Arguments(0)) = "-D" Then intDebug = 1
        End If

' In the code, you can specify that you want to debug a portion by setting
intDebug either side 
' of the code you want to debug

        if intDebug = "" Then intDebug = 0
        
        if intDebug = 1 Then WScript.echo txtDebug
        
End Sub

' ------------------------------ Main Script here

subDebug "Starting Script"

subDebug "Defining Variables"

Dim varDP
Dim aryLine(), aryForCallingSub
Dim intReadCount, intSvrLast, intTSLast, intDHCPLast, intDFSLast,
intFRSLast, intDSLast, intDebug, intNLSLast, intPSLast, intApacheLast,
intWINSLast, intDNSLast, intASOJLast, intASODLast, intASOTLast

Dim objFSO, objFileContents, objWMIService, objItem, objShell, objName,
objTempFile, objTextFile, objReport, objServiceTS, objServiceDHCP,
objServiceDFS, objServiceFRS, objDISK

Dim strLine, strSvrName, strLocal, strCmdLine, strTime, strText,
strWriteLine, strLineWrite
Dim colItems, colServiceTS, colServiceDHCP, colServiceDFS, colServiceFRS,
colDISK, colItem

subDebug "Configuring File System Object"

Err.clear

set objFSO = Wscript.CreateObject("Scripting.FileSystemObject")
set objFileContents = objFSO.OpenTextFile("C:\Servers.csv")

If Err.Number <> 0 Then
        WScript.Echo "Can't open file C:\Servers.csv - Error " & err.number
        Wscript.Quit
End If

subDebug "Opened Servers List"

subDebug "Made it past opening the file and entering the read loop."

do while objFileContents.AtEndOfStream <> True

        strLine = objFileContents.ReadLine

subDebug "Got line: " & strLine

subDebug "Splitting the Array"

subDebug "Status Levels are 0: Service Warning, 1: Service Outage, 2:
Service OK"

        aryForCallingSub = split(strLine, ",")
        strSvrName = aryForCallingSub(0)
        
subDebug "Value 0: " & strSvrName

subDebug "The rest of this code retrieves values from the Array Line"
        
        intSVRLast = fnGetLine(strLine,1)

subDebug "intSVRLast: " & intSVRLast
        
        intDSLast = fnGetLine(strLine,2)
        
subDebug "intDSLast: " & intDSLast
        
        intTSLast = fnGetLine(strLine,3)
        
subDebug "intTSLast: " & intTSLast
        
        intDHCPLast = fnGetLine(strLine,4)

subDebug "intDHCPLast: " & intDHCPLast

        intDFSLast = fnGetLine(strLine,5)

subDebug "intDFSLast: " & intDFSLast

        intFRSLast = fnGetLine(strLine,6)

subDebug "intFRSLast: " & intFRSLast

        intNLSLast = fnGetLine(strLine,7)

subDebug "intNLSLast: " & intNLSLast

        intPSLast = fnGetLine(strLine,8)

subDebug "intPSLast: " & intPSLast

        intApacheLast = fnGetLine(strLine,9)

subDebug "intApacheLast: " & intApacheLast

        intWINSLast = fnGetLine(strLine,10)

subDebug "intWINSLast: " & intWINSLast

        intDNSLast = fnGetLine(strLine,11)

subDebug "intDNSLast: " & intDNSLast

        intASOJLast = fnGetLine(strLine,12)

subDebug "intASOJLast: " & intASOJLast

        intASODLast = fnGetLine(strLine,13)

subDebug "intASODLast: " & intASODLast

        intASOTLast = fnGetLine(strLine,14)
        
subDebug "intASOTLast: " & intASOTLast

subDebug "subCheckServer(" & strTarget & "," & intSvrLast & "," & intTSLast
& "," & intDHCPLast & "," & intDFSLast & "," & intFRSLast & "," & intDSLast
& "," & intNLSLast & "," & intPSLast & "," & intApacheLast & "," &
intWINSLast & "," & intDNSLast & intASOJLast & "," & intASODLast & "," &
intASOTLast & ")"

        call
subCheckServer(strSvrName,intSvrLast,intTSLast,intDHCPLast,intDFSLast,intFRS
Last,intDSLast,intNLSLast,intPSLast,intApacheLast,intWINSLast,intDNSLast,int
ASOJLast,intASODLast,intASOTLast)
        
loop

subDebug "Close File"

objFileContents.Close

objFSO.DeleteFile "C:\Servers.csv", True
objFSO.CopyFile "C:\ServersNew.csv", "C:\Servers.csv"
objFSO.DeleteFile "C:\ServersNew.csv", True

subDebug "File Moved"

subDebug "Script Finished"


' ------------------------------ Subs Below
'
---------------------------------------------------------------------------
subCheckServer

private Sub
subCheckServer(strTarget,intSvrLast,intTSLast,intDHCPLast,intDFSLast,intFRSL
ast,intDSLast,intNLSLast,intPSLast,intApacheLast,intWINSLast,intDNSLast,intA
SOJLast,intASODLast,intASOTLast)

        On Error Resume Next

        Dim intSVRResp,intTSCount,intDHCPCount,intDFSCount,intFRSCount,
intNLSCount, intPScount, intApacheCount, intWINSCount, intDNSCount,
intASOJCount, intASODCount, intASOTCount
        Dim intDSCount
        Dim intFS
        dim intDS
        dim varDP

subDebug "subCheckServer(" & strTarget & "," & intSvrLast & "," & intTSLast
& "," & _
        intDHCPLast & "," & intDFSLast & "," & intFRSLast & "," & intDSLast
& "," & intNLSLast _
        & "," & intPSLast & "," & intApacheLast & "," & intWINSLast & "," &
intDNSLast _
        & intASOJLast & "," & intASODLast & "," & intASOTLast & ")"

        Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
        Set colItems = objWMIService.ExecQuery("Select * from
Win32_ComputerSystem",,48)

subDebug "Get Computer Name"

        For Each objItem in colItems
                strLocal = objItem.Name
        Next
        
subDebug "Computer Name " & strLocal
        
' As Windows 2000 doesn't have a "Win32_PingStatus" class, let's use the
code
' supplied at
http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey0914
.mspx
<http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey091
4.mspx> 

subDebug "Running PING command"
        
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objShell = CreateObject("Wscript.Shell")
        objName = objFSO.GetTempName
        objTempFile = objName
        strCmdLine = "cmd /c ping -n 2 -w 2000 " & strTarget & " >" &
objTempFile
        objShell.Run strCmdLine, 0, True
        
subDebug "Opening output from that ping command"
        
        Set objTextFile = objFSO.OpenTextFile(objTempFile, 1)

subDebug "Setting counter to 0 and entering readline loop"

        Do While objTextFile.AtEndOfStream <> True
                strText = objTextFile.ReadLine
                intSVRResp = 0
                If Instr(strText, "Reply") > 0 Then

subDebug "Got a reply from that box. Applying counter to reflect this"

                        intSVRResp = 2

' This is still more of the code I've had to put in to cover the fact that
Windows 2000 doesn't
' have it's own Win32_PingStatus Class.

' This time, a chunk of code from
http://www.4guysfromrolla.com/webtech/103100-1.2.shtml
<http://www.4guysfromrolla.com/webtech/103100-1.2.shtml> 

subDebug "Pulling apart response line"

        'Create a regular expression object
                        Dim objRegExp
                        Set objRegExp = New RegExp

                        'Set our pattern
                        objRegExp.Pattern = "time(.*?)ms"
                        objRegExp.IgnoreCase = True
                        objRegExp.Global = True

                        'Find the match against our pattern
                        Dim objMatches
                        Set objMatches = objRegExp.Execute(strText)
        
        strTime=Mid(objMatches(0).Value, 6, Len(objMatches(0).Value) - 7)

subDebug "Response time was " & strTime
                        
                        Set objRegExp = Nothing     'Clean up!
        
' End Code from http://www.4guysfromrolla.com/webtech/103100-1.2.shtml
<http://www.4guysfromrolla.com/webtech/103100-1.2.shtml> 
        
' Back to code from
http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey0914
.mspx
<http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey091
4.mspx>         
        
        If strTime>100 Then 
                intSVRResp = 1

subDebug "Response time greater than 100ms. Applying counter to reflect
this"
                
        End If
        
      Exit Do
    End If
        Loop

subDebug "Closing the Ping Store Text File"
        
  objTextFile.Close
        objFSO.DeleteFile(objTempFile)

' End code from
http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey0914
.mspx
<http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey091
4.mspx> 

        If intSVRResp = 2 Or intSVRResp = 1 Then

subDebug "So, we can connect to this box - let's start checking for running
services"

                intTSCount = fnCheckService("Terminal Services",strTarget)
                
subDebug "We got " & intTSCount
                
                intDHCPCount = fnCheckService("DHCP Server",strTarget)

subDebug "We got " & intDHCPCount

                intDFSCount = fnCheckService("Distributed File
System",strTarget)
                
subDebug "We got " & intDFSCount
                
                intFRSCount = fnCheckService("File Replication
Service",strTarget)
                
subDebug "We got " & intFRSCount
                
                intNLSCount = fnCheckService("Net Logon",strTarget)
                
subDebug "We got " & intNLSCount
                
                intPSCount = fnCheckService("Print Spooler",strTarget)
                
subDebug "We got " & intPSCount
                
                intApacheCount = fnCheckService("Apache",strTarget)
                
subDebug "We got " & intApacheCount
                
                intWINSCount = fnCheckService("Windows Internet Name Service
(WINS)",strTarget)
                
subDebug "We got " & intWINSCount
                
                intDNSCount = fnCheckService("DNS Server",strTarget)
                
subDebug "We got " & intDNSCount
                
                intASOJCount = fnCheckService("ASO Job Engine",strTarget)
                
subDebug "We got " & intASOJCount
                
                intASODCount = fnCheckService("ASO Database
Engine",strTarget)
                
subDebug "We got " & intASODCount
                
                intASOTCount = fnCheckService("ASO Tape Engine",strTarget)
                
subDebug "We got " & intASOTCount
                

subDebug "Disk Space - Counter set to 3 in order to identify that the tests
have not been run"

                intDSCount = 3

subDebug "Opening WMI interface to retrieve Logical Disk Information"

' Code partially borrowed from the Microsoft "Coding Guys" Script-o-matic

                Set colItems = GetObject("winmgmts:\\" & strTarget &
"\root\cimv2")._
                        ExecQuery("Select * from Win32_LogicalDisk",,48)
                For Each objItem in colItems
                
subDebug "Looping for Disks"
                
                        If objItem.FileSystem = "NTFS" Then
                        
subDebug "It's an NTFS Partition"                       

                                If IsNull(Instr(objItem.ProviderName, "\\"))
Then
                                
subDebug "It's not a file share"
                                
                                        If objItem.Name <> "A:" AND
objItem.Name <> "B:" Then
                                        
subDebug "It's not your Floppy Disk Drive"

subDebug "Disk: " & objItem.Name

                                                intFS = objItem.FreeSpace

subDebug "Freespace: " & intFS

                                                intDS = objItem.Size

subDebug "Size: " & intDS

                                                varDP = (intFS / intDS) *
100

subDebug "%age Free: " & varDP

                                                If varDP < 3 Then

subDebug "%age free is less than 3 Percent!"

                                                        If intDSCount > 1
Then intDSCount = 1
                                
subDebug "Returning 1"
                                
                                                Else
                                
                                                        If varDP < 10 Then

subDebug "%Age free is less than 10 Percent!"

                                                                If
intDSCount > 1 Then intDSCount = 0
                                        
subDebug "Returning 0"
                                        
                                                        Else

                                                                If
intDSCount > 1 Then intDSCount = 2
                                        
subDebug "Returning 2"
                                        
                                                        End If
                                                End If
                                End If
                        End If
                End If
                Next

subDebug "Enough with the running services already!"

        End If

subDebug "This is where we do the broadcasts - debug messages in there will
reflect this"
        
        If intSVRResp = 0 Then 
                If intSvrLast <> 0 Then subNPBroadcast("Outage: Server Down
(" & strLocal & "->" & strTarget & ")")
        Else

' This didn't work until Spencer Sun spotted I'd missed out some end ifs. I
tidied up the code then which ended up as the following.
'          [ s s u n s s u n AT g m a i l DOT c o m ]

' I had a problem here where if a server was reported as being down, the
next time it starts up, it reports
' each of the services as being back up. Not too much of an issue, but I'm
cost saving ;) Now, it'll warn
' if the server is back up and the service isn't

                If intSVRResp = 1 And intSvrLast <> 1 Then
subNPBroadcast("Warning: Server Slow (" & strLocal & "->" & strTarget & ")")
                If intSVRResp = 2 And intSvrLast <> 2 Then
subNPBroadcast("Status: Server responds OK (" & strLocal & "->" & strTarget
& ")")

                If intDSCount = 0 And intDSLast <> 0 Then
subNPBroadcast("Warning: Server " & strTarget & " has disk(s) under 10% Disk
Space")
                If intDSCount = 1 And intDSLast <> 1 Then
subNPBroadcast("Outage: Server " & strTarget & " has disk(s) under 1% Disk
Space")
                If intDSCount = 2 And intDSLast <> 2 Then
subNPBroadcast("Status: Server " & strTarget & " has disk(s) over 10% Disk
Space")

                call subBroadcastChooser("Terminal
Services",intTSCount,intTSLast,intSvrLast,strLocal,strTarget)
                call subBroadcastChooser("DHCP
Server",intDHCPCount,intDHCPLast,intSvrLast,strLocal,strTarget)
                call
subBroadcastChooser("DFS",intDFSCount,intDFSLast,intSvrLast,strLocal,strTarg
et)
                call
subBroadcastChooser("FRS",intFRSCount,intFRSLast,intSvrLast,strLocal,strTarg
et)
                call subBroadcastChooser("Net
Logon",intNLSCount,intNLSLast,intSvrLast,strLocal,strTarget)
                call subBroadcastChooser("Print
Spooler",intPSCount,intPSLast,intSvrLast,strLocal,strTarget)
                call
subBroadcastChooser("Apache",intApacheCount,intApacheLast,intSvrLast,strLoca
l,strTarget)
                call subBroadcastChooser("WINS
Server",intWINSCount,intWINSLast,intSvrLast,strLocal,strTarget)
                call subBroadcastChooser("DNS
Service",intDNSCount,intDNSLast,intSvrLast,strLocal,strTarget)
                call subBroadcastChooser("ASO
Job",intASOJCount,intASOJLast,intSvrLast,strLocal,strTarget)
                call subBroadcastChooser("ASO
Database",intASODCount,intASODLast,intSvrLast,strLocal,strTarget)
                call subBroadcastChooser("ASO
Tape",intASOTCount,intASOTLast,intSvrLast,strLocal,strTarget)

        End If

subDebug "Creating the ServersNew.csv file"

        If intSVRResp = "" Then intSVRResp = "3"
        If intDSCount = "" Then intDSCount = "3"
        If intTSCount = "" Then intTSCount = "3"
        If intDHCPCount = "" Then intDHCPCount = "3"
        If intDFSCount = "" Then intDFSCount = "3"
        If intFRSCount = "" Then intFRSCount = "3"
        If intNLSCount = "" Then intNLSCount = "3"
        If intPSCount = "" Then intPSCount = "3"
        If intApacheCount = "" Then intApacheCount = "3"
        If intWINSCount = "" Then intWINSCount = "3"
        If intDNSCount = "" Then intDNSCount = "3"
        If intASOJCount = "" Then intASOJCount = "3"
        If intASODCount = "" Then intASODCount = "3"
        If intASOTCount = "" Then intASOTCount = "3"

        strLineWrite = strTarget & "," &  intSVRResp & "," &  intDSCount &
"," &  intTSCount & "," &  intDHCPCount & "," &  intDFSCount & "," &
intFRSCount & "," &  intNLSCount & "," &  intPSCount & "," &  intApacheCount
& "," &  intWINSCount & "," &  intDNSCount & "," &  intASOJCount & "," &
intASODCount & "," &  intASOTCount 

strDebug "Writing line " & strLineWrite

        Err.clear

        set objFSO = Wscript.CreateObject ("Scripting.FileSystemObject")
        Set objReport = objFSO.OpenTextFile("C:\ServersNew.csv", 8, True) '
1 = Read, 2 = Write, 8 = Append
        
        If Err.Number <> 0 Then
                Wscript.Echo "Error creating report file with Result"
                Wscript.Quit
        End If

subDebug "File opened"
        
subDebug "And I was able to create it :) "

subDebug "Writing Line: " & strLineWrite

        objReport.WriteLine strLineWrite
        
subDebug "Closing File"
        
        objReport.Close

End Sub

'
----------------------------------------------------------------------------
fnCheckService

private Function fnCheckService(strServiceName,strServerName)

Dim colService, objService

' This function is designed to reduce repetitive code and retrieve the
running status
' of a service on a remote machine.

subDebug "\\" & strServerName & "\" & strServiceName & " Counter set to 0"

                fnCheckService = 0
                
                Set colService = GetObject("winmgmts://" & strServerName &
"/root/cimv2")._
                        ExecQuery("SELECT * FROM Win32_Service WHERE
DisplayName = '" & strServiceName & "'")

subDebug "Going into the loop"

                For Each objService in colService
                
subDebug "WMI Query Acknowledged"

                        Select Case objService.Started
                
                        Case "" 
                        
subDebug "Maybe we can't authenticate against that server - Return 0"

                                fnCheckService = 0

                        Case "False"
                
subDebug "The service isn't running - Return 1"
                
                                fnCheckService = 1
                                
                        Case "True"
                        
subDebug "Service is running - Return 2"

                                fnCheckService = 2
                                
                        End Select
                        
                Next
                
End Function

'
----------------------------------------------------------------------------
----- fnGetLine

private Function fnGetLine(strLine,intPointer)

' This function is designed to reduce bulky code, and retrieve a particular
pointer in a
' CSV style text array.

        If Instr(strLine, ",") => intPointer Then fnGetLine =
aryForCallingSub(intPointer)

subDebug "Getting Value for " & intPointer & " in the array"

        If fnGetLine = "" Then 

                fnGetLine = "3"

        subDebug "Setting Value " & intPointer & " to Default (" & fnGetLine
& ")"

        End If

End Function

' -----------------------------------------------------------------------
subBroadcastChooser

private sub
subBroadcastChooser(strService,intCount,intLast,intSvrLast,strLocal,strTarge
t)

        If intCount = 0 Then
        
subDebug "Counter for " & strService & " Was 0"

                If intLast <> 0 Then

subDebug "Counter for Last Run of this was not 0 (was " & intLast & ")"

                        subNPBroadcast("Warning: " & strService & " Service
Not On This Server (" & strLocal & "->" & strTarget & ")")

                End If
        End If
                
        If intCount = 1 Then

subDebug "Counter for " & strService & " Was 1"

                If intLast <> 1 Then

subDebug "Counter for Last Run of this was not 1 (was " & intLast & ")"
                
                        subNPBroadcast("Outage: " & strService & " Service
Has Stopped (" & strLocal & "->" & strTarget & ")")
                End If
        End If
                
        If intCount = 2 Then 

subDebug "Counter for " & strService & " Was 2"

                If intLast <> 2 Then

subDebug "Counter for Last Run of this was not 2 (was " & intLast & ")"

                        If intSvrLast <> 0 Then 
                        
subDebug "Server not just up (result " & intSvrLast & ")"
                        
                                subNPBroadcast("Status: " & strService & "
Service OK (" & strLocal & "->" & strTarget & ")")
                        End If
                End If
        End If

end sub

'
----------------------------------------------------------------------------
subNPBroadcast

private Sub subNPBroadcast(txtSendText)

        Set objShell = CreateObject("Wscript.Shell")
        
        If intSvrLast <> 3 Then

subDebug "Broadcasting: " & txtSendText

                objShell.Run "NotifyLite.exe [NLITEG1] " & txtSendText

        Else

                WScript.echo "First Run - No broadcast sent."
                WScript.echo "Broadcasting: " & txtSendText

        End If

subDebug "And then sleeping (for 1000ms) to prevent a DDOS on the first run
of a new batch of servers!"

' This had to be added after we managed to take down the Notify Server on
it's first run!

        wscript.sleep 1000
End Sub

Other related posts:

  • » [windows2000] System Monitoring using WSH, WMI, Ping and a SMS Broadcaster