磁盤空間檢測腳本

'*********************************************************************
'* File: Check Free Space
'* Created: July , 2011
'* Last Modified:   July 6, 2011
'* Version:     1.0
'*
'* Main Function: Check Free Space and Send to Administrator
'*
'*
'* Create by Mark.Xu
'*
'**********************************************************************

Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Declare variables
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Const FREE_SPACE_PERCENT = 99
'If (FreeSpace / DriverSize) <= FREE_SPACE_PERCENT then Send Mail to Administrator
Const HARD_DISK = 3

Dim strSMTP
Dim strSender
Dim strSendto
Dim strTitle
Dim strContext
Dim strAttachment1
Dim mailarray(5,0) 'The mail information to array

Dim strSendmail 'The result of sendmail
Dim strComputer 'The computer
Dim strHostname 'The hostname

Dim objWmiService,colDisks,objdisk
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Give Value to variables
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
strHostname = getHostname()
strSMTP = "192.168.1.1"
strSender = "[email protected]"
strSendto = "[email protected]"
strTitle = strHostname & " Check Free Space is Less than " & FREE_SPACE_PERCENT & "% at " & strnowtime(Now)
strContext = ""
strAttachment1 = ""
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Check the Free Space for each driver
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
    ("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
    If objDisk.FreeSpace / objDisk.Size <= (FREE_SPACE_PERCENT/100) Then
        strContext = strContext & _
                    "DeviceID: "& objDisk.DeviceID & vbTab & convertByte(objDisk.Size) & vbCr &_
                    "Free Disk Space: "&  vbTab & convertByte(objDisk.FreeSpace) & vbCr &_
                    "Free Disk Space Percent: "  & _
                    FormatPercent(objDisk.FreeSpace / objDisk.Size) & vbCr & vbcr
    End if
Next
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'To Send Mail
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If strContext <> "" Then
    mailarray(0,0) = strSMTP
    mailarray(1,0) = strSender
    mailarray(2,0) = strSendto
    mailarray(3,0) = strTitle
    mailarray(4,0) = strContext
    mailarray(5,0) = strAttachment1
    strSendmail = SendMail(mailarray)
End If

'********************************************************************
'*
'* Function SendMail(arrayMail2d)
'* Purpose: To Send mail
'* Input:
'*
'* Output:
'* Notes:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'mailarray format
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'mailarray(0,0) is SMTP
'mailarray(1,0) is Sender
'mailarray(2,0) is Sendto
'mailarray(3,0) is Title
'mailarray(4,0) is Textbody
'mailarray(5,0) is Attachment,if nothing then be null
'Dim mailarray(5,1)
'mailarray(0,0) = "smtp.mailtest.local"
'mailarray(1,0) = "[email protected]"
'mailarray(2,0) = "[email protected]"
'mailarray(3,0) = "Server ReStart"
'mailarray(4,0) = "OK ReStart"
'mailarray(5,1) = "D:\script_center.exe"
'*
'*
'********************************************************************

Function SendMail(arrayMail2d)
On Error Resume Next
Dim objMessage
Dim y
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = arrayMail2d(3,0)
objMessage.Sender = arrayMail2d(1,0)
objMessage.To = arrayMail2d(2,0)
objMessage.TextBody = arrayMail2d(4,0)
For y = 0 To UBound(arraymail2d,2)
If Trim(arraymail2d(5,y)) <> "" Then
objMessage.AddAttachment arraymail2d(5,y)
Else
'WScript.Echo arraymail2d(5,y)
End If
Next

'==This section provides the configuration information for the remote SMTP server.
objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = arrayMail2d(0,0)
 'Server port (typically 25)
objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
If Err.Number = 0 then
SendMail = Err.Number
Else
SendMail = Err.Number & "," & Err.Description
Err.Clear
End If
On Error Goto 0
End Function


'********************************************************************
'*
'* Function getHostname()
'* Purpose: To get hostname
'* Input:
'*
'* Output:
'* Notes:
'********************************************************************
Function getHostname()
Dim objshell
Dim strRegValue
Set objshell = CreateObject("Wscript.Shell")
strRegValue = "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Hostname"
getHostname = objshell.RegRead(strRegValue)
set objshell = Nothing
End Function

'********************************************************************
'*
'* Function strnowtime()
'* Purpose: Convert the time at now to String
'* Input:   strNow as Date
'* Output:  strnowtime as String
'* Notes:   ex "0103_2359"
'*
'********************************************************************
Function strnowtime(strNow)
Dim strYear
Dim strMonth
Dim strDay
Dim strhour
Dim strminute
strYear = Year(strnow)
StrMonth = Month(strnow)
StrDay = Day(strnow)
Strhour = Hour(strnow)
Strminute = Minute(strnow)
If Len(strMonth) = 1 Then
    StrMonth = "0" & strMonth
End If
If Len(strDay) = 1 Then
    StrDay = "0" & strDay
End If
If Len(Strhour) = 1 Then
    strhour = "0" & strhour
End If
If Len(Strminute) = 1 Then
    Strminute = "0" & strminute
End If
strnowtime = strYear & strMonth & strDay & "_" & strhour & strminute
End Function


'********************************************************************
'*
'* Function convertByte(intByte)
'* Purpose: Output the string size with convert
'* Input:
'*
'* Output:
'* Notes:  1000 = 1000 (Byte)
'         10000 = 9.77 (KB)
'       1000000 = 9.54 (MB)
'   10000000000 = 9.31 (GB)
'********************************************************************
Function convertByte(intByte)
If intByte /1024 > 1 Then
    If intByte /1024/1024 > 1 Then
        If intByte /1024/1024/1024 > 1 Then
            convertByte =   FormatNumber((intByte /1024/1024/1024),2) & " (GB)"
        Else
            convertByte = FormatNumber((intByte /1024 /1024),2) & " (MB)"
        End If

    Else
        convertByte = FormatNumber((intByte /1024),2) & " (KB)"
    End If

Else
    convertByte = intByte & " (Byte)"
End If
End Function