【VBS】サーバー死活監視をつくってみた

社内や社外向けサーバーに異常がないかを監視し、アクセスできないなどの以上があった場合メールなどで知らせるシステムです。監視内容はPINGが通るか、webサイトにはアクセスできるか、ファイルシステムにはアクセスできるかといった点を調べるます。簡易版ですのであしからず。VBSで作成しました。

PINGチェック

VBSからcmd.exeを呼び出しPINGを行ないます。エラーだった場合はメールを飛ばすメソッドへ。

Sub Fnc_CheckPING(IP)
   Dim cmd
   Dim wsh
   
   ' WSHでping送信
   cmd = "cmd.exe /c ping " & IP
   Set wsh = CreateObject("WScript.Shell")
   
   
   Dim MailTitle  'メールタイトル
   Dim MailText 'メール本文
   

   ' PINGは通ったか？
   If wsh.Run(cmd, vbNormalFocus, True) Then
       'エラーならメールを飛ばす
       theTitle = IP & " Pingエラー 【死活チェック】"
       theText = IP & "のPingエラーです。"
       Call Fnc_SendEMail(MailTitle, MailText, "")
   End If
                   
   Set wsh = Nothing  ' コマンドの初期化
   
End Sub

ファイルシステムアクセスチェック

PINGだけではなくファイルシステムにアクセスできるかを確認します。\\192.168.xxx.xxxとかでアクセスすることがありますよね？それができるかチェックします。それだけでなくそこにファイルを作成したり削除したりすることができるかもチェックします。バックアップサーバーの死活チェックをするときなどに利用します。

Sub Fnc_CheckFilesystem(path)
	

        ' 適当なファイル名をつける
	filename = "aaaabbbbccccdddd.txt"
	
	Set objFileSys = CreateObject("Scripting.FileSystemObject")
	
	'エラー発生時にも処理を続行するよう設定
	On Error Resume Next
	

　　　　' ファイルを作成する
	Set fn = objFileSys.CreateTextFile(path & "\" & filename)
	
	'エラーになった場合の処理
	If Err.Number <> 0 Then
		
	   MailTitle = path & " ファイルシステムエラー 【死活チェック】"
       	   MailText = path & "のファイルシステムエラーです。" & vbCrLf & _
       				"エラー番号：" & Err.Number & vbCrLf & _
                   	"エラー詳細：" & Err.Description

       	   Call Fnc_SendEMail(theTitle, theText, "")
	
           'エラー情報をクリアする
  	   Err.Clear

	End If
	
	Set fn = Nothing  
	
	
	'ファイルを削除する
	objFileSys.DeleteFile(path & "\" & filename)
	
	On Error Goto 0
	
	Set objFileSys = Nothing  
	
End Sub

Webサイトアクセスチェック

Webサイトにアクセスできるかを確認します。HTTPのステータスコードが200以外であればエラーとします。

Sub Fnc_CheckWebsite(url)

    Set httpObj = CreateObject("MSXML2.ServerXMLHTTP")
	
    httpObj.Open "GET", url
    httpObj.send

    ' readyState=4で読み込みが完了
    Do While httpObj.readyState < 4
        Wscript.sleep 100
    Loop

    Dim statusCode
    statusCode = httpObj.Status

    ' HTTPのステータスコードが200(OK)以外であれば、ステータスコードなどを返す。
    If (statusCode <> 200) Then

        'エラーなら
	MailTitle = url & " Webサイトアクセスエラー 【死活チェック】"
	MailText = url & "のWebサイトアクセスエラーです。確認してください。
	Call Fnc_SendEMail(theTitle, theText, "")

    End If
	
End Sub

最後に

この３つのプログラムを一つにしてエラーメールをひとまとめにするほうがよいでしょう。また、成功メールも１日１回くらい飛ばすようにすればこのプログラムが動いている事がわかります。