Monitor server.

This script will monitor diskspace usage on a server. If the free diskspace drops under 1000 Mb, the script will send an email to a preconfigured smtp address. The amount of free disk space will be stored in an access database to be able to determine data growth over time.

The script will also check the eventlogs for any errors in the past 24 hours and mail them to the configure mail address.

For sending smtp mail I use an external utility blat.exe which can be found here

  • Create an ini file serverchk.ini with the following contents:
    • [MDB]
    • DBFileName=SrvMonitor.mdb
    • [SMTP]
    • recipient=recipient@domain.com
    • sender=sender@domain.com
    • Server=smtpserveraddress
    • smtpuser=leave blank if no authentication needed
    • smtppw=leave blank if no authentication needed
    
    '***************************************************************************
    '** Script:         ServerChk.vbs
    '** Version:      1.1
    '** Created:      date / time
    '** Author:         Adriaan Westra
    '** E-mail:         
    '**
    '** Purpose / Comments:
    '**               Check health of the Server
    '**               Check space on localharddisk. If free space < 1000 Mb
    '**               Send mail to specified mail address
    '**               If there were errors in the eventlog, mail them.
    '**
    '** Changelog :
    '** 30-07-2004 9:33  :   Initial version (Diskspace checking)
    '** 12-08-2004 15:47 :  Added eventlog checking
    '** date / time         : 
    '**
    '***************************************************************************
    
    '***************************************************************************
    '** Declaration of variables used by the template
    Dim Version : Version = "1.1" ' Script version
    Dim Author : Author = "Adriaan Westra"
    Dim Email : Email = ""
    Dim Logging : Logging = "off"  
    Dim strScript    ' scriptname
    Dim strPath      ' Script Startup path 
    Dim FSO         ' File System Object
    
    '***************************************************************************
    '** Declaration of constants
    '** FileAcces
    Const ForReading = 1
    Const ForWriting = 2
    Const ForAppend = 8
    '** Database Access
    Const adOpenKeyset = 1
    Const adOpenDynamic = 2
    Const adLockPessimistic = 2
    Const adCmdText = 1
    '** Domain access
    Const GROUP_TYPE_GLOBAL_GROUP = 2
    Const GROUP_TYPE_LOCAL_GROUP = 4
    Const GROUP_TYPE_SECURITY_ENABLED = &h80000000
    Const GROUP_TYPE_UNIVERSAL_GROUP = 8
    '** WMI Constants
    Const unknown = 0
    Const NoRootDir = 1
    Const RemovableDisk = 2
    Const LocalDisk = 3
    Const Networkdrive = 4
    Const CompactDisc = 5
    Const RAMDisk = 6
    
    
    '** Do not Process records older then "Interval" Hours
    Const Interval = -24 
    
    '***************************************************************************
    '** Add Error Handling
    on error resume Next
    
    '***************************************************************************
    '** Make sure the script is started with cscript
    If InStr(wscript.FullName, "wscript.exe") > 0 Then
       MsgBox "Please run this script with cscript.exe." & Chr(13) & _
              "For example : cscript " & WScript.ScriptName & " /?", _ 
              vbExclamation, WScript.ScriptName
       WScript.Quit(1)
    End If
    
    '***************************************************************************
    '** Get startup path from scriptfullname
    Pos = InStr(wscript.ScriptFullName, wscript.ScriptName)
    strPath = Mid(wscript.ScriptFullName,1,Pos - 1)
    Pos = InStr(wscript.ScriptName, ".")
    strScript = Mid(wscript.ScriptName,1,Pos - 1)
    
    '***************************************************************************
    '** Get commandline parameters
    Set Args = Wscript.Arguments
    
    '***************************************************************************
    '** No commandline parameters, display inputbox
    'If Args.Count = 0 Then
    '   Var = InputBox("Give Var : ",wscript.scriptname, "Default Value")
    '   If Var = "" Then
    '      WScript.Echo
    '      WScript.Echo "Error var is not filled!! "
    '      WScript.Echo
    '      DisplayHelp
    '      WScript.Quit(1)
    '   End if
    'End if
    
    '***************************************************************************
    '** Check for help in commandline parameters
    If Args.Count = 1 Then
       If InStr(Args(0),"/?") > 0 Or InStr(UCase(Args(0)),"/H") > 0 _ 
       Or InStr(UCase(Args(0)),"/HELP") > 0  Then
          DisplayHelp
          Wscript.quit(0)
       Else
          strComputer = Args(0)
       End If
    Else
       strComputer = "."
    End If
               
    '***************************************************************************
    '** There are commandline parameters, parse and check them
    For Each arg in args
        If arg = "/log" Then
            Logging = "on"
        End If
    Next
    
    '***************************************************************************
    '** Declare Variables
    Dim Var                              ' Explanation for vars
    Dim LogDir : LogDir = strPath & "VBSlog"   ' Directory for logging
    Dim LogFileName  : LogFileName = LogDir & "\" & strScript & ".log"
    Dim LogFile
    
    '***************************************************************************
    '** Log Options 
    If Logging = "on" Then
       Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
       If Not fso.FolderExists(LogDir) Then
          Set LogFolder = Fso.CreateFolder(LogDir)
       End If
       Set LogFile = FSO.OpenTextFile(LogFileName, ForWriting, True)
       LogLine = Now & " ==> Start of script : " & Wscript.scriptname
       LogFile.WriteLine LogLine
    End If
    
    '***************************************************************************
    '** Start of script! Add Code after this Line
    
    Dim objCmd      ' Command object         '
    Dim objConn      ' Connection object
    Dim objRst      ' Recordset object
    Dim FS         ' FileSystemObject
    
    '***************************************************************************
    '** Get databasename from inifile
    strDatabase = ReadIni("ServerChk.ini" , "MDB", "DBFileName")
    
    '***************************************************************************
    '** Check if database exists if not create new one
    Set FS = WScript.CreateObject("Scripting.FileSystemObject")
    If Not FS.FileExists(strDatabase) Then
       Dim objADODb
       Set objADODb = CreateObject("ADOX.Catalog")
    
       'Create the database file
       objADODb.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                           "Data Source=" & strDatabase
    End If
                           
    '***************************************************************************
    '** create a ADO connection and open a Access database
    Set objConn = CreateObject("ADODB.Connection")
    
    objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabase
    
    SendMail = 0
    SendFileName = "Subject.txt"
    
    '***************************************************************************
    '** Open file to be sent as attachement
    Set SmtpFile = FS.OpenTextFile(SendFileName, ForWriting, True)
    
    SmtpFile.writeline "Report generated by " & Wscript.scriptname & " At " & Now
    SmtpFile.writeline
    
    '***************************************************************************
    '** 
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_LogicalDisk ")
    '***************************************************************************
    '** 
    For Each objItem in colItems
        
        If objItem.DriveType = LocalDisk Then
        
           strTabel = "Disk" & Mid(objItem.name,1,1)
           
           Set objRst = objConn.Execute("Select * From " & strTabel)
           
           If Err.number = -2147217865 Then
              err.clear
             Set objCmd = objConn.Execute("CREATE TABLE " & strTabel & _
             " (FreeMb Integer, DateTimeStamp DateTime);")
          End If
          
          
           Set objCmd = objConn.Execute("INSERT INTO " & strTabel & _
            " (FreeMb, DateTimeStamp) VALUES (" & _
           CLng(objItem.Freespace / (1024 * 1024)) & ", '" & Now &  "');")
       
       
           PercFreeSpace = (objItem.FreeSpace / objItem.Size) * 100
           
           
           SmtpFile.writeline  objItem.Name & " - " & objItem.VolumeName & _
            " ( " &objItem.Description & " ) "
           SmtpFile.writeline "Total Space: " & _
           FormatNumber(objItem.Size / (1024 * 1024), 0) & " Mb"
          SmtpFile.writeline "Free Space: " & _
           FormatNumber(objItem.FreeSpace / (1024 * 1024), 0) & " Mb"
          SmtpFile.writeline "Free Space: " & _
           FormatNumber(PercFreeSpace, 0) & " %"
          SmtpFile.writeline
          
          If (objItem.Freespace / (1024 * 1024)) < 1000 Then
             SendMail = 1
          End If
          
        End If
    Next
    
    objConn.Close
    
    
    
    '***************************************************************************
    '** bind to the WMI service, note the Security privelige is specified, this
    '** is require to access the Security log                                 
    Set objService = GetObject("winmgmts:{impersonationLevel=impersonate," _
                               & "(Security)}!\\" & strComputer)           
                                                                        
    '***************************************************************************
    '** get time zone                                                         
    Set colItems = objService.ExecQuery("Select * From Win32_ComputerSystem ")
                                                                        
    For Each objItem in colItems                                           
                                                                           
        nTimeZone = objItem.Currenttimezone                                
    next                                                                   
         
    '***************************************************************************
    '** only retrieve entries within the last Interval 
    Set objWMISet = objService.ExecQuery("SELECT Message, " & _                    
       "TimeWritten, User,Type, SourceName, Logfile, Computername," & _ 
       " EventCode FROM Win32_NTLogEvent WHERE " & _        
       " (Type='audit failure' Or Type='error' Or Type='warning' ) And " & _        
       "TimeWritten> '" & _ 
       Convert2DMTFDate(DateAdd("h", Interval, Now), nTimeZone) & "'")
                                                                                    
                                                                                    
    '***************************************************************************
    '** loop through each event                                                       
    For Each objEvent In objWMISet 
      
       boolIgnore = 0
       
       '** Eventid's to ignore
       Select Case objEvent.EventCode
          Case 2004
             If objEvent.SourceName = "PerfNet" Then
                boolIgnore = 1
             End if
       End Select
       
       
       If boolIgnore = 0 and err.number = 0 and objEvent.Type = "error" Then                                                
          SmtpFile.WriteLine "Log :  " & objEvent.Logfile & _
           "              Computer: " & objEvent.Computername
          SmtpFile.WriteLine "Time: " & DMTFDate2String(objEvent.TimeWritten)  & _ 
          "       EventId: " & objEvent.EventCode
          SmtpFile.WriteLine "Source: " & objEvent.SourceName & _
           "                 Type:" & objEvent.Type  
          If IsNull(objEvent.User) Then
             SmtpFile.WriteLine  "User: N/A                       Message:"
          Else
             SmtpFile.WriteLine  "User: " & objEvent.User  & _ 
             "                      Message:"
          End if
          If Not IsNull(objEvent.Message) Then                              
             SmtpFile.WriteLine  _ 
             Replace(objEvent.Message,chr(13) & chr(10), chr(13))        
          End If                                                            
          SmtpFile.WriteLine                                             
          sendmail = 1  
       End If
    
     Next              
     
    smtpFile.close
    
    '***************************************************************************
    '** Send E-mail
    If SendMail Then
       strRecpt = ReadIni("ServerChk.ini" , "SMTP", "recipient")
       strServer = ReadIni("ServerChk.ini" , "SMTP", "server")
       strSender = ReadIni("ServerChk.ini" , "SMTP", "sender")
       strUser = ReadIni("ServerChk.ini" , "SMTP", "smtpuser")
       strpw = ReadIni("ServerChk.ini" , "SMTP", "smtppw")
       Set WS = Wscript.CreateObject("Wscript.Shell")
       strSendCommand = "blat.exe " & SendFileName & " -to " & Chr(34) & _
       strRecpt &  Chr(34)  & " -subject " & Chr(34) & "Error report" & _
       Chr(34) & " -f " & strSender & " -server " & strServer
       If strUser <> "" Then 
          strSendCommand = strSendCommand & " -u " & strUser & " -pw " & _
          strpw
       End If 
       wscript.echo strSendcommand 
       ws.run(strSendCommand)
    End If
    
    '***************************************************************************
    '** End of script   
    If Logging = "on" Then
       LogLine = Now & " ==> End of script : " & Wscript.scriptname
       LogFile.WriteLine LogLine
       LogFile.Close    
    End If              
                        
    Wscript.Quit()      
    '***************************************************************************
    '** Sub:            DisplayHelp
    '** Version:      1.0
    '** Created:      24-03-2003 8:22
    '** Author:         Adriaan Westra
    '** E-mail:         
    '**
    '** Purpose / Comments:
    '**               Display help for script
    '**
    '** Arguments      :
    '**
    '** Changelog :
    '** 24-03-2003 8:22  :   Initial version
    '**
    '***************************************************************************
    Sub DisplayHelp()
       wscript.echo "***************************************************************************"
       wscript.echo "** "
       wscript.echo "** Online help for " & Wscript.scriptname & " version : " & Version
       wscript.echo "** "
       wscript.echo "** Usage : cscript " & Wscript.scriptname 
       wscript.echo "** "
       wscript.echo "** Purpose : Check health of a server "
       wscript.echo "** "
       wscript.echo "** Author : " & Author
       wscript.echo "** E-mail : " & Email
       wscript.echo "** "
       wscript.echo "***************************************************************************"
    End Sub
    '***************************************************************************
    '** Function:      ReadIni
    '** Version:      1.1
    '** Created:      19-03-2003 11:02
    '** Author:         Adriaan Westra
    '** E-mail:         
    '**
    '** Purpose / Comments:
    '**               Reads a value from an iniFile
    '**
    '** Arguments      :
    '**   strINIFile   : Name of the IniFile to read
    '**   strSection   : Section in the inifile to read from
    '**   strKey      : Key of the value to read
    '**
    '** Changelog :
    '** 19-03-2003 11:15  :   Initial version
    '** 19-03-2003 11:25  :   Built in UpperCase Check
    '**
    '***************************************************************************
    Function ReadINI(strINIFile, strSection, strKey)
     Dim objFSO, objTextFile, strLine
    
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set objTextFile = objFSO.OpenTextFile(strINIFile)
    
     'loop through each line and check for key value
     Do While Not objTextFile.AtEndOfStream
        strLine = objTextFile.ReadLine
        If UCase(strLine) = UCase("[" & strSection & "]") Then
             Do While Not objTextFile.AtEndOfStream
                 strLine = objTextFile.ReadLine
                If UCase(Left(strLine, Len(strKey) + 1)) = UCase(strKey & "=") Then
                   ReadINI = Mid(strLine, InStr(strLine, "=") + 1)
                   Exit do
                End If
            Loop
            Exit Do
         End If
     Loop
    
     objTextFile.Close
    
    End Function
    Sub ErrorHandling()
       Select Case err.number
          Case 0
             Exit sub
          Case    -2147467259
             wscript.echo "Database is gelocked"
             wscript.quit(1)
          Case else
             wscript.echo err.number & " " & err.description
             err.clear
         End select
    End Sub
    
    Function Convert2DMTFDate(dDate, nTimeZone)                                                  
       Dim sTemp, sTimeZone                                                                      
                                                                                                 
       sTimeZone = nTimeZone                                                                     
       If nTimeZone>=0 Then sTimeZone = "+" & sTimeZone                                          
                                                                                                 
       sTemp = Year(Now) & Pad(Month(dDate), 2, "0") & Pad(Day(dDate), 2, "0")                   
       sTemp = sTemp & Pad(Hour(dDate), 2, "0") & Pad(Minute(dDate), 2, "0")                     
       sTemp = sTemp & "00.000000" & sTimeZone                                                   
                                                                                                 
       Convert2DMTFDate = sTemp                                                                  
    End Function                                                                                 
                                                                                                 
    Function Pad(sPadString, nWidth, sPadChar)                                                   
                                                                                                 
        If Len(sPadString) < nWidth Then                                                         
            Pad = String(nWidth - Len(sPadString), sPadChar) & sPadString                        
        Else                                                                                     
            Pad = sPadString                                                                     
        End If                                                                                   
                                                                                                 
    End Function                                                                                 
                                                                                                 
    'DMTFDate2String                                                                             
    'Converts WMI DMTF dates to a readable string                                                 
    'Parameters:                                                                                 
    'strDate    Date in DMTF format                                                              
    'Returns                                                               
    'formatted date string                                                 
    Function DMTFDate2String(strDate)
     strDate = Cstr(strDate)
     DMTFDate2String = Mid(strDate, 5, 2) & "/" & Mid(strDate, 7, 2) _
              & "/" & Mid(strDate, 1, 4) & " " & Mid(strDate, 9, 2) _
              & ":" & Mid(strDate, 11, 2) & ":" & Mid(strDate, 13, 2)
    End Function