イベントビューアの内容を送付

サーバの状態を確認するのは結構大変です。

とりあえず動いていると見落としがちなものが多くあります。

ダンプファイルを解析するのが一番良い方法ですが、イベントビューアは一つの不具合の調査材料にはなります。

ただ、一つ一つのサーバにログオンし、イベントビューアを見るのはかなり時間がかかります。

その際、毎日タスク登録してメールを送信すれば毎日はサーバにログオンしなくてもよくなり、

少しは楽になるんじゃないかと考えました。

といったところで、下記のスクリプトを作成してみました。

Option Explicit
' ----------------------
' パソコンごとの設定
' ----------------------
Const strMailFrom = "***@***.co.jp " ' 送信元メールアドレス
Const strMailTo = "****@***.co.jp " ' 送信先メールアドレス
Const strSMTPServer = "*****.*****.co.jp" ' SMTPサーバ名
Const intSMTPPort = 25 ' SMTPポート
Const strSubjectOK = ”イベントログ収集" ' 正常時の件名
Const strSubjectNG = "イベントログ収集" ' 異常時の件名
Const intInterval = 1442 ' イベントログを収集する期間(分)
' 抽出条件
'Const strWhere0 = "Logfile='System' or Logfile='Application'" ' システムとアプリケーションのログを収集
Const strWhere0 = ""
Const strWhere1 = ""
Const strWhere2 = "SourceName<>'W3SVC'" ' W3SVC(IIS)の警告を無視
Const strWhere3 = "SourceName<>'DNS'" ' DNS関連のメッセージを無視
Const strWhere4 = "SourceName<>'SpntLog'" ' リアルタイム検索の警告を無視
Const strWhere5 = ""
Const strWhere6 = "SourceName<>'TermServDevices'" ' リモートデスクトップ接続のエラーを無視
Const strWhere7 = ""
Const strWhere8 = ""
Const strWhere9 = ""
' 例)
' Logfile='System' or Logfile='Application' ← システムかアプリケーション
' SourceName<>'SecurityCenter' and SourceName<>'Service Control Manager' ← 特定ソースの除外
' EventCode<>'33' and EventCode<>'7035' ← 特定イベントコードの除外
' ------------------------------
' パソコンごとの設定(ここまで)
' ------------------------------

' ------------
' 変数の宣言
' ------------
dim dtmStartDateTime
dim strBias
dim strQuery
dim strComputer
dim objWMIService
dim colLoggedEvents
dim objEvent
dim intEventCount
dim intErrorCount
dim intI
dim intJ
dim strSubject
dim strTextBody
dim strKeyLogfile

' --------------------------------------------------
' 対象とする開始日時を変数(dtmStartDateTime)に編集
' --------------------------------------------------
On Error Resume Next ' エラー中断を停止
' XPならOK、2000ではエラーになる
Set dtmStartDateTime = CreateObject("WbemScripting.SWbemDateTime")
if Err = 0 then
On Error goto 0 ' エラー中断を再開
' dtmStartDateTimeをSWbemで編集
dtmStartDateTime.SetVarDate DateAdd("n",- intInterval,Now), True
else
Error.Clear
On Error goto 0 ' エラー中断を再開
dim objSWbemServices
dim objTimeZone
dim colTimeZone
strComputer = "."
' 時差(分)を取得
Set objSWbemServices = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colTimeZone = objSWbemServices.ExecQuery ("SELECT * FROM Win32_TimeZone")
For Each objTimeZone in colTimeZone
strBias = objTimeZone.Bias
Next
' dtmStartDateTimeをコーディングで編集
dtmStartDateTime = DateAdd("n",- intInterval,Now)
dtmStartDateTime = Year(dtmStartDateTime) & _
right("0" & Month(dtmStartDateTime),2) & _
right("0" & Day(dtmStartDateTime),2) & _
right("0" & Hour(dtmStartDateTime), 2) & _
right("0" & Minute(dtmStartDateTime), 2) & _
right("0" & Second(dtmStartDateTime), 2) & ".000000"
if strBias < 0 then
dtmStartDateTime = dtmStartDateTime & "-" & Abs(strBias)
else
dtmStartDateTime = dtmStartDateTime & "+" & Abs(strBias)
end if
end if
' -----------------------------------
' WMIからイベントログを参照する準備
' -----------------------------------
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
strQuery = "Select * from Win32_NTLogEvent Where (EventType='1' or EventType='2')" ' 1,2,5のｲﾍﾞﾝﾄを見ます。(エラー、警告、失敗の監査)
strQuery = strQuery & " and (TimeWritten > '" & dtmStartDateTime & "')"
' 抽出条件(追加分)
if strWhere0 <> "" then
strQuery = strQuery & " and (" & strWhere0 & ")"
end if
if strWhere1 <> "" then
strQuery = strQuery & " and (" & strWhere1 & ")"
end if
if strWhere2 <> "" then
strQuery = strQuery & " and (" & strWhere2 & ")"
end if
if strWhere3 <> "" then
strQuery = strQuery & " and (" & strWhere3 & ")"
end if
if strWhere4 <> "" then
strQuery = strQuery & " and (" & strWhere4 & ")"
end if
if strWhere5 <> "" then
strQuery = strQuery & " and (" & strWhere5 & ")"
end if
if strWhere6 <> "" then
strQuery = strQuery & " and (" & strWhere6 & ")"
end if
if strWhere7 <> "" then
strQuery = strQuery & " and (" & strWhere7 & ")"
end if
if strWhere8 <> "" then
strQuery = strQuery & " and (" & strWhere8 & ")"
end if
if strWhere9 <> "" then
strQuery = strQuery & " and (" & strWhere9 & ")"
end if
Set colLoggedEvents = objWMIService.ExecQuery (strQuery)
'Wscript.Echo strQuery
intEventCount = 0 ' イベント件数を初期化
intErrorCount = 0 ' エラー件数を初期化
strTextBody = "" ' メール本文用変数を初期化
strKeyLogfile = "" ' ログの種類変数を初期化

' -----------------------------------
' WMIからイベントログを参照して編集
' -----------------------------------
if colLoggedEvents.Count > 0 then
dim strLogfile()
dim intRecordNumber()
dim strType()
dim strTimeWritten()
dim strEventCode()
dim strSourceName()
dim strMessage()
For Each objEvent in colLoggedEvents
intEventCount = intEventCount + 1
redim Preserve strLogfile(intEventCount)
redim Preserve intRecordNumber(intEventCount)
redim Preserve strType(intEventCount)
redim Preserve strTimeWritten(intEventCount)
redim Preserve strEventCode(intEventCount)
redim Preserve strSourceName(intEventCount)
redim Preserve strMessage(intEventCount)
' テーブルに取り込み
strLogfile(intEventCount) = objEvent.Logfile ' ログの種類
intRecordNumber(intEventCount) = objEvent.RecordNumber
' エラーを判定
if objEvent.EventType = "1" then
' エラーのとき
intErrorCount = intErrorCount + 1
strType(intEventCount) = "●"
elseif objEvent.EventType = "2" or objEvent.EventType = "5" then
' 警告のとき
' -------------------------------------------------------
' 拾う必要が無い警告を無視するよう判定を追加(ここから)
' -------------------------------------------------------
if objEvent.SourceName = "@@@@" then
strType(intEventCount) = "○"
'elseif objEvent.SourceName = "XXXX" then
' strType(intEventCount) = "○"
' -------------------------------------------------------
' 拾う必要が無い警告を無視するよう判定を追加(ここまで)
' -------------------------------------------------------
else
strType(intEventCount) = "▲"
intErrorCount = intErrorCount + 1
end if
else
' -----------------------------------------------------------
' アプリケーションが出すエラーを拾うよう判定を追加(ここから)
' -----------------------------------------------------------
' DNSと通信ができないとき
if objEvent.SourceName = "@@@@" and left(objEvent.Message,4) = "@@@@" then
strType(intEventCount) = "▲"
intErrorCount = intErrorCount + 1
'elseif objEvent.SourceName = "XXXX" and objEvent.EventCode = "9999" then
' strType(intEventCount) = "▲"
' intErrorCount = intErrorCount + 1
' -----------------------------------------------------------
' アプリケーションが出すエラーを拾うよう判定を追加(ここまで)
' -----------------------------------------------------------
else
strType(intEventCount) = "○"
end if
end if
strType(intEventCount) = strType(intEventCount) & objEvent.Type ' エラー,警告,情報
strTimeWritten(intEventCount) = WMIDateStringToDate(objEvent.TimeWritten) '発生日時
strEventCode(intEventCount) = objEvent.EventCode ' イベントコード
strSourceName(intEventCount) = objEvent.SourceName 'ソース
strMessage(intEventCount) = objEvent.Message ' 詳細
' 最後の改行を除く
if strMessage(intEventCount) & "" <> "" then
Do While right(strMessage(intEventCount),2) = vbCrLf
strMessage(intEventCount) = left(strMessage(intEventCount),len(strMessage(intEventCount))-2)
if strMessage(intEventCount) & "" = "" then
exit do
end if
Loop
end if
Next
' 並べ替え
intI = 1
Do While intI < intEventCount
intJ = intI + 1
Do While intJ <= intEventCount
if (strLogfile(intJ) < strLogfile(intI)) or _
(strLogfile(intJ) = strLogfile(intI) and intRecordNumber(intJ) < intRecordNumber(intI)) then
strLogfile(0) = strLogfile(intI)
strLogfile(intI) = strLogfile(intJ)
strLogfile(intJ) = strLogfile(0)
intRecordNumber(0) = intRecordNumber(intI)
intRecordNumber(intI) = intRecordNumber(intJ)
intRecordNumber(intJ) = intRecordNumber(0)
strType(0) = strType(intI)
strType(intI) = strType(intJ)
strType(intJ) = strType(0)
strTimeWritten(0) = strTimeWritten(intI)
strTimeWritten(intI) = strTimeWritten(intJ)
strTimeWritten(intJ) = strTimeWritten(0)
strEventCode(0) = strEventCode(intI)
strEventCode(intI) = strEventCode(intJ)
strEventCode(intJ) = strEventCode(0)
strSourceName(0) = strSourceName(intI)
strSourceName(intI) = strSourceName(intJ)
strSourceName(intJ) = strSourceName(0)
strMessage(0) = strMessage(intI)
strMessage(intI) = strMessage(intJ)
strMessage(intJ) = strMessage(0)
end if
intJ = intJ + 1
Loop
intI = intI + 1
Loop
intI = 1
Do While intI <= intEventCount
' メール本文を編集
if strTextBody <> "" then
strTextBody = strTextBody & vbCrLf
end if
if strKeyLogfile <> strLogfile(intI) then
strTextBody = strTextBody & "■" & strLogfile(intI) ' ログの種類
strTextBody = strTextBody & vbCrLf & vbCrLf
strKeyLogfile = strLogfile(intI)
end if
strTextBody = strTextBody & strType(intI) ' エラー,警告,情報
strTextBody = strTextBody & " " & strTimeWritten(intI) '発生日時
strTextBody = strTextBody & " (" & strEventCode(intI) & ")" ' イベントコード
strTextBody = strTextBody & strSourceName(intI) 'ソース
strTextBody = strTextBody & vbCrLf
strTextBody = strTextBody & strMessage(intI) ' 詳細
strTextBody = strTextBody & vbCrLf
intI = intI + 1
Loop
end if

' -----------
' WMIの解放
' -----------
Set objEvent = Nothing
Set colLoggedEvents = Nothing
Set objWMIService = Nothing

' ----------------------------------
' エラーの有無を判定して件名を編集
' ----------------------------------
if intErrorCount = 0 then
strSubject = strSubjectOK
else
strSubject = strSubjectNG
end if
strSubject = strSubject & " " & Mid(Year(Now),3) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2)
strSubject = strSubject & " " & Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
strSubject = strSubject & " " & intErrorCount & "/" & intEventCount & "件"

' -------------------
' CDOでメールを送信
' -------------------
call sMail(strSubject ,strTextBody)

Function WMIDateStringToDate(dtmEventDate)
' --------------------------------------
' WMIの日付をyyyy/mm/dd hh:nn:ssに変換
' --------------------------------------
WMIDateStringToDate = CDate(Mid(dtmEventDate, 5, 2) & "/" & Mid(dtmEventDate, 7, 2) & "/" & Left(dtmEventDate, 4) _
& " " & Mid(dtmEventDate, 9, 2) & ":" & Mid(dtmEventDate, 11, 2) & ":" & Mid(dtmEventDate, 13, 2))
End Function

Function sMail(strSubject ,strTextBody)
' --------------
' メールを送信
' --------------
dim oMsg
Set oMsg = CreateObject("CDO.Message")
oMsg.From = strMailFrom
oMsg.To = strMailTo
oMsg.Subject = strSubject
oMsg.TextBody = strTextBody
oMsg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing ") = 2
oMsg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver ") = strSMTPServer
oMsg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport ") = intSMTPPort
oMsg.Configuration.Fields.Update
oMsg.Send
End Function

赤字部分を変更するとすぐ使用できるスクリプトとなっています。