サーバの空き容量をメールで配信する ( Windows Server

続きここからはサーバ管理用の記述

ディスク容量定期監視メール

DiskUsage.vbs

Windows2008 R2 以降

Option Explicit

'WMIにて使用する各種オブジェクトを定義・生成する。
Dim oClassSet
Dim oClass
Dim oLocator
Dim oService
Dim sMesStr
Dim CPUInfo
Dim CPUCore
Dim Sendto
Dim UsageThreshold

'通知先
Sendto = "test1@example.com"
'ディスク使用容量しきい値使用領域設定：単位(%)
UsageThreshold = 80

'ローカルコンピュータに接続する。
Set oLocator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer
'クエリー条件をWQLにて指定する。
Set oClassSet = oService.ExecQuery("Select * From Win32_Processor")

'コレクションを解析する。
For Each oClass In oClassSet

CPUInfo = oClass.Name
CPUCore = oClass.NumberOfCores

'sMesStr = sMesStr & "種類：" & oClass.Description & vbCrLf & _
'"名前：" & oClass.Name & vbCrLf & _
'"製造元：" & oClass.Manufacturer & vbCrLf & "コア数 :" & oClass.NumberOfCores & vbCrLf & _
'"現在の周波数：" & CStr(oClass.CurrentClockSpeed) & vbCrLf & _
'"最大周波数：" & CStr(oClass.MaxClockSpeed) & vbCrLf & _
'"L2キャッシュサイズ：" & CStr(oClass.L2CacheSize) & vbCrLf & vbCrLf

sMesStr = sMesStr & "" & vbCrLf & _
"CPU名前：" & oClass.Name & vbCrLf & "コア数 :" & oClass.NumberOfCores & vbCrLf & _
vbCrLf

'MsgBox("Processorに関する情報です。" & vbCrLf & vbCrLf & sMesStr)

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'###########################

'Dim oClassSet
'Dim oClass
'Dim oLocator
'Dim oService
'Dim sMesStr
Dim Pcname
Dim Oss
Dim Bitt

'コレクションを解析する。
For Each oClass In oClassSet

Pcname = oClass.CSName
Oss = oClass.Caption
Spp = oClass.ServicePackMajorVersion
Bitt = oClass.OSArchitecture

'sMesStr = sMesStr & "" & oClass.CSName & _
'"" & oClass.Description & vbCrLf & vbCrLf
'Set Pcname = oClass.CSName

'MsgBox "" & vbCrLf & vbCrLf & sMesStr

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'WMIにて使用する各種オブジェクトを定義・生成する。

Dim lRet

'コレクションを解析する。
For Each oClass In oClassSet

lRet =round (( oClass.TotalPhysicalMemory) / 1024/1024,0)

'sMesStr = sMesStr & "" & oClass.CSName & vbCrLf & _
'"コンピュータの説明:" & oClass.Description & vbCrLf & vbCrLf
'MsgBox "Memory :" & CStr(lRet) & "MBeです。"

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'WMIにて使用する各種オブジェクトを定義・生成する。
'Dim oClassSet
'Dim oClass
'Dim oLocator
'Dim oService
'Dim sMesStr
Dim Ipadd
Dim Spp
Dim Bbody
'ローカルコンピュータに接続する。
Set oLocator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer
'クエリー条件をWQLにて指定する。
Set oClassSet = oService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration")

'コレクションを解析する。
For Each oClass In oClassSet

If oClass.IPEnabled = True Then
Ipadd = oClass.IPAddress(0)

body = CStr(Pcname) & " [" & Ipadd & "] " & vbCrLf & CStr(Oss) & " " & _
CStr(Bitt) & vbCrLf & "SP:" & CStr(Spp) & vbCrLf & "Memory :"& CStr(lRet) & "MB" & vbCrLf & vbCrLf
'"IPアドレス：" & oClass.IPAddress(0) & vbCrLf & _
'"サブネットマスク：" & oClass.IPSubnet(0) & vbCrLf & _
'"DHCPの状態：" & CStr(oClass.DHCPEnabled) & vbCrLf & vbCrLf

End If

'MsgBox "" & vbCrLf & vbCrLf & sMesStr

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'##############################################

'Option Explicit

Dim WarningCount
'Dim Pcname
Dim MailSubject
Dim Body
Dim MailBody
Dim SmtpHost
Dim SmtpPort
'Dim SmtpSSL
'Dim SmtpUser
'Dim SmtpPassword
Dim SmtpFrom

Dim net

'変数値set
Set net = CreateObject("WScript.Network")
Pcname = net.ComputerName
SmtpFrom = Pcname & "@example.com" & "<" & Pcname & "@example.com>"
'メールあて先

SmtpHost = "localhost"
'smtp auth or ssl の場合は以下必須
'SmtpSSL = True
'smtp port番号
SmtpPort = 25
'SmtpUser = "test1@example.com"
'SmtpPassword = "from_at_example_com_password"

MailSubject = "[" & Pcname & " Disk Warning ] ディスク容量監視警告 (" & UsageThreshold & "% 超過): " & Pcname
WarningCount = 0

'***
'ローカルコンピュータに接続する。
Set oLocator = Wscript.CreateObject("WbemScripting.SWbemLocator")

Set oService = oLocator.ConnectServer
'クエリー条件をWQLにて指定する。
Set oClassSet = oService.ExecQuery("Select * From Win32_OperatingSystem")
'コレクションを解析する。
For Each oClass In oClassSet
sMesStr = sMesStr & "OS:" & CStr(oClass.Caption) & CStr(Bitt) & vbCrLf _
& "SP(R) : SP(R)" & CStr(oClass.ServicePackMajorVersion) & vbCrLf _
& "Build:" & CStr(oClass.Version) & vbCrLf _
& "Memory :" & CStr(lRet) & "MB" & vbCrLf

Dim objWMIService
'Dim objSWbemObjectCollection
'Dim net
'Dim objSWbemObject
'Dim DeviceID
'Dim Size
'Dim FreeSpace
'Dim ExistPersent
'Dim Caution
Dim objIpSet
Dim objConfig
Dim objMessage
Dim Bill
Dim UsageSpace

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Dim objSWbemObjectCollection
Set objSWbemObjectCollection = objWMIService.ExecQuery("Select * from Win32_LogicalDisk Where DriveType = 3")
Dim objSWbemObject
Mailbody = Mailbody & Pcname & " [" & CStr(Ipadd) & "]" & vbCrLf _
& sMesStr & vbCrLf & "ディスク監視閾値を超えました。ディスク使用閾値:"& UsageThreshold & "% 以上" & vbCrLf
For Each objSWbemObject in objSWbemObjectCollection
Dim DeviceID
Dim Size
Dim FreeSpace
Dim ExistPersent
Dim Caution
DeviceID = objSWbemObject.DeviceID
Size = objSWbemObject.Size
FreeSpace = objSWbemObject.FreeSpace
UsageSpace = Size - FreeSpace
ExistPersent = 100 - FreeSpace / Size * 100
If ( ExistPersent > CDbl(UsageThreshold) ) Then
Caution = "CAUTION!!!"
WarningCount = WarningCount + 1
Else
Caution = ""
End If

MailBody = MailBody & DeviceID & vbTab & "空き" & round((FreeSpace / 1024 / 1024 / 1024),1) _
& "GB" & vbTab & "全体" & round((Size / 1024 / 1024 / 1024),1) & "GB" _
& "" & vbTab & "利用" & round((UsageSpace / 1024 / 1024 / 1024),1) & "GB" & vbTab _
& "使用域" & round((ExistPersent),1) & "%" & vbTab & Caution & vbCrLf
Next

Mailbody = Mailbody & vbCrLf & "" & vbCrLf & "---" & Pcname & " Disk Usage Check cron mail" & vbCrLf

If ( WarningCount > 0 ) Then
Call SendMail(SmtpFrom, Sendto, MailSubject , MailBody )
End IF

Sub SendMail(FromMailAddress, ToMailAddress, Subject, Body )
Dim objConfig
Set objConfig = CreateObject("CDO.Configuration")
objConfig.Fields.Item( "http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
' objConfig.Fields.Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl") = SmtpSSL
objConfig.Fields.Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver") = SmtpHost
objConfig.Fields.Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SmtpPort

'ユーザー認証
' objConfig.Fields.Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
' objConfig.Fields.Item( "http://schemas.microsoft.com/cdo/configuration/sendusername") = SmtpUser
' objConfig.Fields.Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword") = SmtpPassword

objConfig.Fields.Update

Dim objMessage
Set objMessage = CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig

objMessage.BodyPart.Charset = "utf-8"
objMessage.Fields.Item("urn:schemas:mailheader:Precedence") = "bulk"
objMessage.Fields.Item("urn:schemas:mailheader:X-Mailer") = "Windows CDO Message"
objMessage.Fields.Update

objMessage.From = FromMailAddress
objMessage.To = ToMailAddress
objMessage.Subject = Subject
objMessage.TextBody = Body

objMessage.Send

' If Err.Number = 0 Then
' WScript.Echo "メールを送信しました。"
' Else
' WScript.Echo "メールの送信に失敗しました。" & _
' "(" & Err.Description & ")"
' End If
End Sub

Set WarningCount =Nothing
Set Pcname =Nothing
Set MailSubject =Nothing
Set MailBody =Nothing
Set UsageThreshold =Nothing
Set SmtpHost =Nothing
Set SmtpPort =Nothing
'Set SmtpSSL =Nothing
'Set SmtpUser =Nothing
'Set SmtpPassword =Nothing
Set SmtpFrom =Nothing
Set Sendto =Nothing
Set net =Nothing
Set oLocator =Nothing
Set oService =Nothing
Set oClassSet =Nothing
Set oClass =Nothing
Set sMesStr =Nothing

Set oLocator = Nothing
Set objWMIService = Nothing
Set objSWbemObjectCollection = Nothing
Set DeviceID = Nothing
Set Size = Nothing
Set FreeSpace = Nothing
Set ExistPersent = Nothing
Set Caution = Nothing
Set MailBody = Nothing
Set oClassSet =Nothing
Set oService = Nothing
Set oClassSet = Nothing
Set Pcname = Nothing
Set Oss = Nothing
Set Bitt = Nothing
Set Bill = Nothing
Set Ipadd = Nothing
Set Spp = Nothing
Set lRet = Nothing

#2

Windows2003 R2 以前

Option Explicit

'WMIにて使用する各種オブジェクトを定義・生成する。
Dim oClassSet
Dim oClass
Dim oLocator
Dim oService
Dim sMesStr
Dim CPUInfo
Dim CPUCore
Dim Sendto
Dim UsageThreshold

'通知先
Sendto = "hoge.hoge@hoge.com"
'ディスク使用容量しきい値使用領域設定：単位(%)
UsageThreshold = 80

'コレクションを解析する。
For Each oClass In oClassSet

CPUInfo = oClass.Name

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'###########################

Dim Pcname
Dim Oss
Dim Bitt

'コレクションを解析する。
For Each oClass In oClassSet

Pcname = oClass.CSName
Oss = oClass.Caption
Spp = oClass.ServicePackMajorVersion

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'WMIにて使用する各種オブジェクトを定義・生成する。

Dim lRet

'コレクションを解析する。
For Each oClass In oClassSet

lRet =round (( oClass.TotalPhysicalMemory) / 1024/1024,0)

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'WMIにて使用する各種オブジェクトを定義・生成する。
Dim Ipadd
Dim Spp
Dim Bbody
'ローカルコンピュータに接続する。
Set oLocator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer
'クエリー条件をWQLにて指定する。
Set oClassSet = oService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration")

'コレクションを解析する。
For Each oClass In oClassSet

If oClass.IPEnabled = True Then
Ipadd = oClass.IPAddress(0)

body = CStr(Pcname) & " [" & Ipadd & "] " & vbCrLf & CStr(Oss) & " " & _
CStr(Bitt) & vbCrLf & "SP:" & CStr(Spp) & vbCrLf & "Memory :"& CStr(lRet) & "MB" & vbCrLf & vbCrLf

End If

'使用した各種オブジェクトを後片付けする。
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

'##############################################

'Option Explicit

Dim WarningCount
Dim MailSubject
Dim Body
Dim MailBody
Dim SmtpHost
Dim SmtpPort
Dim SmtpFrom

Dim net

'変数値set
Set net = CreateObject("WScript.Network")
Pcname = net.ComputerName
SmtpFrom = Pcname & "@hoge.com" & "<" & Pcname & "@hoge.com>"
'メールあて先

SmtpHost = "smtp.fecins.hoge.com"
'smtp auth or ssl の場合は以下必須
'SmtpSSL = True
'smtp port番号
SmtpPort = 25
'SmtpUser = "hoge.smtpuser@hoge.com"
'SmtpPassword = "from_at_example_com_password"

MailSubject = "[" & Pcname & " Disk Warning ] ディスク容量監視警告 (" & UsageThreshold & "% 超過): " & Pcname
WarningCount = 0

'***
'ローカルコンピュータに接続する。
Set oLocator = Wscript.CreateObject("WbemScripting.SWbemLocator")

Dim objWMIService
Dim objIpSet
Dim objConfig
Dim objMessage
Dim Bill
Dim UsageSpace

Mailbody = Mailbody & vbCrLf & "" & vbCrLf & "---" & Pcname & " Disk Usage Check cron mail" & vbCrLf

If ( WarningCount > 0 ) Then
Call SendMail(SmtpFrom, Sendto, MailSubject , MailBody )
End IF

objConfig.Fields.Update

Dim objMessage
Set objMessage = CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig

objMessage.From = FromMailAddress
objMessage.To = ToMailAddress
objMessage.Subject = Subject
objMessage.TextBody = Body

objMessage.Send

' If Err.Number = 0 Then
' WScript.Echo "メールを送信しました。"
' Else
' WScript.Echo "メールの送信に失敗しました。" & _
' "(" & Err.Description & ")"
' End If
End Sub