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

    Set Email=Nothing

End Function

本文轉自 bilinyee部落格，原文連結：     http://blog.51cto.com/ericfu/1668943   如需轉載請自行聯系原作者