VBScript - check disk space and email if above xx%?

Author

check disk space and email if above xx%?

sumGirl

2004-09-23, 3:56 pm

Anyone have an example of a script that would do this that will run on
windows2000? I founf one at MS site that will only run on WinXP and
Win2003.

dlbjr

2004-09-23, 8:56 pm

'This will get you started.
Set SC = New SpaceChecker
Set SC = Nothing

Class SpaceChecker

Private Sub Class_Initialize()
strComputer = "."
Set WMIService = GetObject(" winmgmts:{impersonationLevel=impersonate
}!\\" & strComputer &
"\root\cimv2")
Set colDisks = WMIService.ExecQuery("Select * from Win32_LogicalDisk")
For each Disk in colDisks
'Local and Network Drives Only
If Disk.DriveType >= 3 And Disk.DriveType =< 4 Then
msgbox Disk.DeviceID & " " &
FormatNumber(Divide(CheckNumber(Disk.FreeSpace),CheckNumber(Disk.Size)) * 100,2)
End If
Next
Set colDisks = Nothing
Set WMIService = Nothing
End Sub

Private Sub Class_Terminate()

End Sub

Private Function Divide(int1,int2)
Divide = 0
If CDbl(int1) > 0 And CDbl(int2) > 0 Then
Divide = int1 / int2
End If
End Function

Private Function CheckNumber(int1)
CheckNumber = 0
If IsNumeric(int1) Then
CheckNumber = int1
End If
End Function
End Class

--
'dlbjr
'Pleading sagacious indoctrination!

sumGirl

2004-09-27, 3:55 pm

thanks dlbjr!

goog_l@yahoo.com

2004-09-28, 3:57 am

emebohw@netscape.net (sumGirl) wrote in message news:<a5e13cff.0409270539.68097ec9@posting.google.com>...
> thanks dlbjr!

Cool HTML

'~~Author~~. Rob Dunn
'
'~~Version~~. 1.5 - January 8th, 2004
'
'~~Email_Address~~. qc_metal@hotmail.com
'
'~~Script_Type~~. vbscript
'
'~~Sub_Type~~. System Administration
'
'~~Keywords~~. vbscript, disk space, windows 2000, xp, NT, HTM
' email via SMTP, regwrite, regread
'
'~~Comment~~.
'
' DriveSpace to HTM and email results VBS script (drivespace.vbs)
'
'This script will pull a listing of servers from (in this example,
''c:\temp\servers.txt,' query each server for locally attached hard
drives, and
'then find the total, used, and free space percentage and write it to
an HTM file
'in your temp directory. A 'warning.htm' file is created with only
those drives
'that have triggered the thresholds you set below - background colors
are set to
'differentiate between critical/warning/errors.
'
'Additionally, in the summary and warning htm, each server has been
linked to the
'drive's administrative share string (c$, d$, etc.) so you can quickly
click on
'each drive and do a little cleaning - I believe that this works with
I.E. only -
'you may need to modify it so the links are file://|, etc. for
Netscape.
'
'If you do not have a sourcefile to pull data from, the script will
prompt you
'with an inputbox to query one machine.
'
'If specified via variables in the script, it will email you (thanks
to Nathan
'Strimling's email via SMTP script) the warning.htm file at the end of
the
'execution. If there are no warnings, the file will not be emailed.
There are
'other options you can set to attach both the warning and summary htm
files in
'the email prior to sending.
'
'The script is set up by default to email once per day on the day that
it is run.
'By altering the sMailOnceDaily var, you can turn this on or off (we
have ours
'set to run every 5 minutes, so emailing would be a little annoying!)
so, you
'could send it every time it runs.
'
' The format of the servers.txt file is:
'server1
'server2
'server3
'
'// Set the visual basic constants as they do not exist within
VBScript.
' Do not set your smtp server information here.
Const cdoSendUsingMethod =
"http://schemas.microsoft.com/cdo/configuration/sendusing", _
cdoSendUsingPort = 2, _
cdoSMTPServer =
"http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const HARD_DISK = 3
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Dim strComputer, Silent, strGBFree, strDiskFreeSpace, strDrvString
Dim strDiskDrive, strPercFree, strDiskUsed, CurTime, OutputDir
Dim cbgcolor, wbgcolor, strbgcolor, varlastemail, vartoday, fstyle
Dim sMailSched, strMailTo, strMailFrom, strSubject, StrMessage,
strSMTPServer
Dim Command, Count, sPCCount, varSendMail
Dim f, r, w, ws, WshSysEnv, WshShell
On Error Resume Next

'------------------------------------------------------------------------
' Set variables here:
'------------------------------------------------------------------------
strCompany = "CompanyName" 'this is the name that will be inserted
into the
' registry (HKLM\Software\%strCompany%\IS\DriveSpac
e)
Silent = 0 ' 0/1
' '0' opens HTM summary after script runs
' '1' does not open HTM summary
strCrit = 10 'if free space % is below this threshold, make
critical
strWarn = 20 'if free space % is below this threshold but not below
sCrit,
' then don't make critical, make warning instead
cbgcolor = "#FF6600" 'set critical background color
wbgcolor = "blanchedalmond" 'set warning background color
ebgcolor = "darkgray" 'set error background color
nbgcolor = "white" 'set normal background color
SourceFile = "C:\servers.txt" 'set where to pull server names from
OutputDir = "" 'set root directory that you will save HTMs in
' if blank, it will default to your temp folder
' - format must not have a trailing backslash!
' i.e. "c:\temp"
fstyle = "Arial" 'set default font for table
Email = 1 ' 0/1
' '0' does not send email
' '1' sends email after execution
sMailSched = "1,2,3,4,5,6,7" 'set the days of w

that you want to
email on
' '1' is sunday
' '2' is monday, etc.
' separate numbers by commas
strMailto = "you@domain.com" 'who are you mailing to
strMailFrom = "replyto@domain.com" 'reply address
strSubject = "Low Drive Space Report" 'mail subject
strMsgBody = "See attachment(s)" & ""_
& ", low drive space report" 'message body for emails with attachments
strSMTPServer = "x.x.x.x" 'set SMTP email server address here

sMailOnceDaily = 1 ' 0/1 - send when?
' '0' sends only on days of w

specified
' in strMailSched
' '1' sends email every time script is run

sSendAs = 2 ' 0/1/2/3 - send email type as
' *only* if there are warnings...
' '0' sends warning as body of email
' '1' sends warning as attachment
' '2' sends warning as body, and overall
' summary as attachment
' '3' sends both files as attachments

Count = 0
'------------------------------------------------------------------------

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("PROCESS")
Set ws = CreateObject ("Scripting.FileSystemObject")

'write key into registry for email logic
WshShell.RegWrite "HKLM\SOFTWARE\" & strCompany & "\IS\DriveSpace\",
1, "REG_SZ"
WshShell.RegWrite "HKLM\SOFTWARE\" & strCompany &
"\IS\DriveSpace\LastEmail", "", "REG_SZ"

'------------------------------------------------------------------------
If OutputDir = "" Then
OutputFile = WshSysEnv("TEMP") & "\drivespace.htm"
WarningFile = WshSysEnv("TEMP") & "\warning.htm"
Else
OutputFile = OutputDir & "\drivespace.htm"
WarningFIle = OutputDir & "\warning.htm"
End If

'if there is no sourcefile, then use the host computer name and
' generate a sourcefile with only that computer name in it.
If CheckFileExists(sourcefile) Then
WshShell.Popup "Now checking computer listing from " & sourcefile &
""_
& "...", 2, "Querying computers...", 0 + 64
Else
WshShell.Popup "Cannot find " & Chr(34) & SourceFile & Chr(34)_
& ". " & Wscript.fullname & " will now prompt you for a computer "_
& "name to query.", 4, SourceFile & " not found.", 0 + 32

strComputer = wshShell.ExpandEnvironmentStrings("%Computername%")
strComputer = InputBox("Type the name of the server or PC that you
would " & ""_
& "like to query for printer information from","Type computer
name",strComputer)

Set w = ws.OpenTextFile (SourceFile, ForAppending, True)
w.Writeline (strcomputer)
w.close
WshShell.Popup "Now checking computer " & strcomputer & ""_
& "...", 2, "Querying computer...", 0 + 64
If strComputer = "" Then
wscript.quit
End If
End If

'Checks to see if this file exists, then deletes it prior to making a
new
'one (otherwise it would append to the end of the file).
If CheckFileExists(outputfile) Then
Set oldfile = ws.GetFile(OutputFile)
'wscript.echo OutPutFile & " exists. Now deleting."
oldfile.Delete
End If

If CheckFileExists(warningfile) Then
Set oldfile = ws.GetFile(warningfile)
'wscript.echo OutPutFile & " exists. Now deleting."
oldfile.Delete
End If
'------------------------------------------------------------------------

CurTime = Now 'find current time that you executed the script
strSubject = "Low Drive Space Report - " & CurTime
sPCCount = 0
'Set w = ws.OpenTextFile (OutputFile, ForAppending, True)

Do While Count <= 1
If Count = 1 Then
Set w = ws.OpenTextFile (WarningFile, ForAppending, True)
ElseIf Count = 0 Then
Set w = ws.OpenTextFile (OutputFile, ForAppending, True)
End If
w.Writeline ("<html>")
w.Writeline ("<head>")
w.Writeline ("<title>Drive Space info at " & CurTime & "</title>")
w.Writeline ("</head>")
w.Writeline ("<table BORDER=0 width=100% cellspacing=0
cellpadding=3>")
w.Writeline ("<tr>")
w.Writeline ("<th bgcolor=#000080 colspan=5 width=100%>")
w.Writeline (""_
& "Reading computer listing from file " & SourceFile & "")
w.Writeline ("</th>")
w.Writeline ("</tr>")
w.Writeline ("<h0>Drive
Space info at "_
& CurTime & "</h0>")
w.Writeline ("<th bgcolor=#000080 colspan=5 width=100%>")
w.Writeline ("")
w.Writeline (" ")
w.Writeline ("</tr>")
w.Writeline ("<TR>")
w.Writeline ("<TD> Computer Name </TD>")
w.Writeline ("<TD> Drive </TD>")
w.Writeline ("<TD> Total Size </TD>")
w.Writeline ("<TD> Space Used </TD>")
w.Writeline ("<TD> % Free </TD>")
w.Writeline ("</TR>")
Count = Count + 1
w.close
Loop
'------------------------------------------------------------------------

Count = 0

Set f = ws.OpenTextFile (SourceFile, ForReading, True)
Do While f.AtEndOfStream <> True
If f.AtEndOfStream <> True Then
strDiskDrive = ""
strDiskSize = ""
strDiskUsed = ""
strPercFree = ""
strStatus = ""

strComputer = f.ReadLine 'set input string to computername

Set objWMIService = GetObject("winmgmts:" & ""_
& "{impersonationLevel=impersonate}!\\" & strComputer &
"\root\cimv2")

'if PC cannot be found, then do the following:
If CStr(err.number) = 462 Then
'wscript.echo CStr(err.number) & " description: " &
err.description
strStatus = vbtab & " - error: " & err.description
strDiskSize = "n/a"
strDiskUsed = "n/a"
strPercFree = "n/a"
strBgcolor = ebgcolor 'set bgcolor of row to warning color
varSendMail = 1
Count = Count + 1
err.clear
writelines

'if it can be found, then proceed
Else
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK &
"")

For Each objDisk in colDisks
'to get GB size, divide by 1073741824 (same as dividing space by
' 1024 / 1024 / 1024)
strDiskDrive = objDisk.DeviceID
strDiskUsed = FormatNumber((objDisk.Size - objDisk.FreeSpace) /
1073741824)
strDiskSize = FormatNumber(objDisk.Size / 1073741824,2)
strDiskFree = FormatNumber(objDisk.Freespace / 1073741824,2)
strPercFree = FormatNumber(objDisk.FreeSpace/objDisk.Size,2)
strPercFree = strPercFree * 100 'multiply percent by 100 to get
whole number
'wscript.echo strPercFree & "% free."

strDrvString = Left(strDiskDrive,1)

'If the percentage free is less than or equal to warning level %
' and percentage free is greater than critical level % then set
to warning
If strPercFree <= strWarn and strPercFree > strCrit Then
'wscript.echo "Warning! Drive " & Chr(34) & strDiskDrive & Chr(34)
& ""_
'& " has triggered the threshold warning! Drive has " &
strPercFree & "% free."
varSendMail = 1 'set script to email (if there are no warnings,
why send
' an email?)
strBgcolor = wbgcolor 'set bgcolor of row to warning color
Count = Count + 1
'If percentage free is less than warning % and percentage free
is
' less than or equal to critical %, then set to critical

ElseIf strPercFree < strWarn and strPercFree <= strCrit Then
'wscript.echo "Critical! Drive " & Chr(34) & strDiskDrive &
Chr(34) & ""_
'& " has triggered the threshold warning! Drive has " &
strPercFree & "% free."
varSendMail = 1 'set script to email (if there are no warnings,
why send
' an email?)
strBgcolor = cbgcolor 'set bgcolor of row to critical color
Count = Count + 1

End If

Call WriteLines
Next
End If

sPCCount = sPCCount + 1
Count = 0
End If
Loop

CurTime = Now
On Error GoTo 0

'Now finishing the HTM file...
Do While Count <= 1
If Count = 1 Then
Set w = ws.OpenTextFile(WarningFile, ForAppending,True)
w.Writeline ("<tr bgcolor=black colspan=5 width=100%><TR
bgcolor=black><TD>"_
& " finished
processing "_
& sPCCount & " servers at " & CurTime & " (this is a partial
listing)"_
& "</TD></tr></table></html>")
w.close
Set w = ws.OpenTextFile(WarningFile, ForReading, False,
TristateUseDefault)

ElseIf Count = 0 Then
Set w = ws.OpenTextFile (OutputFile, ForAppending, True)
w.Writeline ("<tr bgcolor=black colspan=5 width=100%><TR
bgcolor=black><TD>"_
& " finished
processing "_
& sPCCount & " servers at " & CurTime &
"</TD></tr></table></html>")
w.close
Set w = ws.OpenTextFile(OutputFile, ForReading, False,
TristateUseDefault)
End If

Count = Count + 1
'read entire contents of output or warning file into strmessage
var
strMessage = w.ReadAll
w.close
Loop

If Silent = 0 Then
'Now run the file in your default associated program...
Command = OutputFile
WshShell.Run Command,1,False
End If

'get the day of the w

at time of execution
varToday = W

day(Date)

If sMailOnceDaily = 0 Then
bkey = WSHShell.RegRead(" HKLM\SOFTWARE\KerryInc\IS\DriveSpace\Las
tEmail")
If InStr(1,bkey,Date) Then
Email = 0
End If
End If

If Email = 1 Then
If varSendMail = 1 Then
'if today's numerical value is found in the sMailSched string
' then run the email function.
If InStr(1,sMailSched,varToday) Then
'wscript.echo "Now emailing to " & strMailto & "..."
WshShell.RegWrite
" HKLM\SOFTWARE\KerryInc\IS\DriveSpace\Las
tEmail",Date, "REG_SZ"
Call EmailFile
End If
End If
End If

'------------------------------------------------------------------------
'Write the actual lines of data into the file
'------------------------------------------------------------------------
Function Writelines
If Count = 1 Then
Set w = ws.OpenTextFile (WarningFile, ForAppending, True)
ElseIf Count = 0 Then
Set w = ws.OpenTextFile (OutputFile, ForAppending, True)
End If
w.Writeline ("<TR>")
w.Writeline ("<TD bgcolor=" & Chr(34) & strbgcolor & Chr(34)
& "><a href=" & Chr(34) &
"\\" & strcomputer & ""_
& "\" & strDrvString & "$" & Chr(34) & ">" & strComputer &
"</a>" & strStatus & " </TD>")
w.Writeline ("<TD bgcolor=" & Chr(34) & strbgcolor & Chr(34)
& ">" & strDiskDrive &
"</TD>")
w.Writeline ("<TD bgcolor=" & Chr(34) & strbgcolor & Chr(34)
& ">" & strDiskSize & " GB
</TD>")
w.Writeline ("<TD bgcolor="& Chr(34) & strbgcolor & Chr(34)
& ">" & strDiskUsed & " GB
</TD>")
w.Writeline ("<TD bgcolor=" & Chr(34) & strbgcolor & Chr(34)
& ">" & strPercFree & "%
</TD>")
w.Writeline ("</TR>")
w.close
If Count = 1 Then
Count = Count - 1
WriteLines
End If

'Count = 0
' strComputer = ""
' strDiskDrive = ""
' strDiskSize = ""
' strDiskUsed = ""
' strPercFree = ""
strbgcolor = nbgcolor

End Function

'------------------------------------------------------------------------
'Function CheFileExists - to see if file exists
'------------------------------------------------------------------------
Function CheckFileExists(sFileName)

Dim FileSystemObject

Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

If (FileSystemObject.FileExists(sFileName)) Then
CheckFileExists = True
Else
CheckFileExists = False
End If

Set FileSystemObject = Nothing

End Function

'------------------------------------------------------------------------
'Function EmailFile - email the warning file
'------------------------------------------------------------------------
Function EmailFile
Dim iMsg, iConf, Flds

'// Create the CDO connections.
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields

'// SMTP server configuration.
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort

'// Set the SMTP server address here.
.Item(cdoSMTPServer) = strSMTPServer
.Update
End With

'// Set the message properties.
With iMsg
Set .Configuration = iConf
.To = strMailTo
.From = strMailFrom
.Subject = strSubject
'.TextBody = strMessage
End With

If sSendAs = 0 Then
iMsg.HTMLBody = strMessage
ElseIf sSendAs = 1 Then
iMsg.iConf.TextBody = strMsgBody
iMsg.AddAttachment WarningFile
ElseIf sSendAs = 2 Then
iMsg.HTMLBody = strMessage
iMsg.AddAttachment OutputFile
ElseIf sSendAs = 3 Then
'iMsg.iConf.TextBody = strMsgBody
iMsg.AddAttachment WarningFile
iMsg.AddAttachment OutputFile
End If

'// Send the message.

iMsg.Send ' send the message.
End Function

Sponsored Links