Disk Space Checking
On Error Resume Next
Dim fso, DiskDriver,DD,Showfreespace,Totalsizespace,SizePercent
Dim SendmailPermission
SendmailPermission = 0
Set fso = wscript.createobject("scripting.filesystemobject")
If (fso.folderexists("C:\Disk2")) = False then
Set foldr=fso.createfolder("C:\Disk2")
End if
Set tf = fso.CreateTextFile("c:\Disk2\DiskSpacelog.txt", True)
Set Drivers = fso.Drives
For Each DiskDriver in Drivers
'list all drives in the computer
DD = DiskDriver.DriveLetter
Set drv = fso.GetDrive( DD & ":")
s=drv.DriveType
If s = 2 And DD <> "Q" Then
Showfreespace = DD & " Local Disk Free Space is " & FormatNumber (drv.FreeSpace/1024/1024/1024,1) & "GB"
'WScript.Echo Showfreespace
tf.WriteLine Showfreespace
Totalsizespace = DD & " Local Disk Total Size is " & FormatNumber (drv.TotalSize/1024/1024/1024,1) & "GB"
'WScript.Echo Totalsizespace
'tf.WriteLine Totalsizespace
SizePercentNumber= drv.FreeSpace / drv.TotalSize * 100
SizePercent = "Free Space Size Percent is " & FormatNumber (drv.FreeSpace / drv.TotalSize * 100,2) & "%"
'WScript.Echo SizePercent
tf.WriteLine SizePercent
tf.WriteLine "=================================="
Showfreespace = Null
Totalsizespace = Null
SizePercent = Null
If SizePercentNumber < 11 Then
SendmailPermission = 1
End If
End If
Next
MyDate = "Checking Date is " & Date
tf.WriteLine MyDate
tf.Close()
If SendmailPermission = 1 Then
sendmailresult=SendMail("[email protected]","Welcome1","[email protected]","Warning:Low Free Disk Space On Srv10101", "Warning:free disk space is less than 11% on Srv10101 !!!","C:\disk2\DiskSpacelog.txt")
'sendmailresult=SendMail("[email protected]","Welcome1","[email protected]","Srv10101 Disk Space Checking", "Warning:Srv10101 have low free disk space !!!","C:\disk2\DiskSpacelog.txt")
End If
Function SendMail(SendFrom,Password,SendTo,MailTopic,MailBody,MailAttachment)
On error resume next
MS_Space = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.BodyPart.Charset = "GBK"
Email.From = SendFrom
Email.To = SendTo
Email.Subject = MailTopic
Email.Htmlbody = MailBody
If MailAttachment <> "" Then
For i=0 to Ubound(Split(MailAttachment,";"))
Email.AddAttachment Split(MailAttachment,";")(i)
Next
End If
With Email.Configuration.Fields
.Item(MS_Space&"sendusing") = 2
.Item(MS_Space&"smtpserver") = "smtp."&Split(SendFrom,"@",-1, vbTextCompare)(1)
.Item(MS_Space&"smtpserverport") = 25
.Item(MS_Space&"smtpauthenticate") = 1
.Item(MS_Space&"sendusername") =Split(SendFrom,"@",-1,vbTextCompare)(0)
.Item(MS_Space&"sendpassword") = Password
.Update
End With
Err.clear
Email.Send
If Err.number<>0 Then
SendMail=False
Else
SendMail=True
End If
Set Email=Nothing
End Function
本文出自 “Erick WAY” 博客，谢绝转载！