- '*********************************************************************
- '* 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 = "abc@abc.com"
- strSendto = "abc@abc.com"
- 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) = "ServerAlert@mailtest.local"
- 'mailarray(2,0) = "mailadmin@mailtest.local"
- '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
转载于:https://blog.51cto.com/381691/740706