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
