' ' DDNS更新ページをリクエストし、 ' IPアドレスに変更があった場合、イベントログ&メールするスクリプト ' (livedoor domain版) ' ' author jomora@jomora.net (http://jomora.net/) ' ' version 2006.05.27 実行日付・時刻を標準出力するように変更 ' version 2006.05.22 エラー時にもメール送信するように変更 ' version 2006.05.14 livedoor domain用のIP変更メール通知機能 追加 ' version 2006.03.17 livedoor domain用に変更 ' version 2005.10.03 POP before SMTP 対応 ' version 2005.06.21 ServerXMLHTTPに変更、setTimeoutsを追加 ' version 2005.06.05 作成 ' livedoor domainのDDNS更新情報 Const ddnsHostname = "hostname" Const ddnsUsername = "username" Const ddnsPassword = "password" ' IPアドレスに変更があったことをメールで通知するかどうか Const useMailAlertIPChanged = True Const smtpSrv = "smtp.server" Const mailFrom = "mail@from" Const mailTo = "mail@to" ' IPアドレス変更メール通知の際、POP before SMTPを利用するかどうか Const usePOPbeforeSMTP = False Const popSrv = "pop.server" Const popUsername = "" Const popPassword = "" ' 以下、変更の必要はないはず Const url = "http://domain.livedoor.com/webapp/dice/update?hostname=" '**Start Encode** ' メインルーチン WScript.StdOut.WriteLine "-----" & now() oldIP = GetIPFromNSLookup(ddnsHostname) WScript.StdOut.WriteLine "oldIP : " & oldIP ddnsResponseText = GetDDNSResponseText(ddnsHostname, ddnsUsername, ddnsPassword) WScript.StdOut.Write ddnsResponseText newIP = GetIPFromResponseText(ddnsResponseText) WScript.StdOut.WriteLine "newIP : " & newIP 'IPアドレスに更新があった場合通知 If oldIP <> newIP Then Call PrintLog(0, "[DDNS] IPアドレスが更新されました。", ddnsResponseText) End If WScript.Quit Function GetDDNSResponseText(ddnsHostname, ddnsUsername, ddnsPassword) GetDDNSResponseText = "" 'DDNS更新ページを一時ファイルとしてバイナリ形式でダウンロード Set objHTTP = WScript.CreateObject("MSXML2.ServerXMLHTTP") objHTTP.Open "GET", url & ddnsHostname, False, ddnsUsername, ddnsPassword objHTTP.setTimeouts 3000, 3000, 3000, 30000 'ServerXMLHTTP利用時 objHTTP.Send If objHTTP.status <> 200 Then Call PrintLog(1, "[DDNS] 結果の取得に失敗しました (HTTP STATUS:" & objHTTP.status & ")", ddnsResponseText) WScript.Quit(1) End If GetDDNSResponseText = objHTTP.responseText If GetDDNSResponseText = "" Then Call PrintLog(1, "[DDNS] レスポンスが null です", ddnsResponseText) WScript.Quit(1) End If End Function Function GetIPFromResponseText(ddnsResponseText) GetIPFromResponseText = "" Set regEx = New RegExp regEx.Pattern = "IP: " For Each line In Split(ddnsResponseText, vbLf) If regEx.Test(line) Then GetIPFromResponseText = Split(line, " ")(1) End If Next If GetIPFromResponseText = "" Then Call PrintLog(1, "[DDNS] IP取得に失敗しました", ddnsResponseText) WScript.Quit(1) End If End Function Function GetIPFromNSLookup(hostname) GetIPFromNSLookup = "" Set regEx = New RegExp regEx.Pattern = "Address: " Set WshShell = WScript.CreateObject("WScript.Shell") Set Pipe = WshShell.Exec("nslookup " & hostname) Do Until Pipe.StdOut.AtEndOfStream line = Pipe.StdOut.ReadLine() If regEx.Test(line) Then GetIPFromNSLookup = Split(line, " ")(2) End If Loop If GetIPFromNSLookup = "" Then Call PrintLog(1, "[DDNS] 旧IP取得に失敗しました", GetIPFromNSLookup) WScript.Quit(1) End If End Function ' IPアドレス変更結果出力 Sub PrintLog(status, title, message) WScript.StdOut.WriteLine title & vbCrLf & message 'イベントログに記録 Set objShell = CreateObject("WScript.Shell") Call objShell.LogEvent(status, title & vbCrLf & message) 'メール送信 If useMailAlertIPChanged Then If usePOPbeforeSMTP Then Call POP3Login(popSrv, popUsername, popPassword) End If Call SMTPSend(smtpSrv, mailFrom, mailTo, title, message) End If End Sub Sub SMTPSend(smtpSrv, mailFrom, mailTo, subject, mailBody) 'メール送信 Set oMsg = CreateObject("CDO.Message") oMsg.From = mailFrom oMsg.To = mailTo oMsg.Subject = subject oMsg.TextBody = mailBody & vbCrLf oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpSrv oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 oMsg.Configuration.Fields.Update oMsg.Send Wscript.Echo "メールを送信しました。" End Sub 'POP3サーバにLOGIN・QUITする Sub POP3Login(popSrv, popUsername, popPassword) Dim iret Dim objPop3 Set objPop3 = WScript.CreateObject("ASLib.POP3") objPop3.POP3User = popUsername objPop3.POP3Pass = popPassword 'Connect iret = objPop3.Connect(popSrv) if iret <> 0 Then Call WriteError("Connect", iret, objPop3) Set objPop3 = Nothing Exit Sub End If 'LOGIN iret = objPop3.LOGIN if iret <> 0 Then Call WriteError("LOGIN", iret, objPop3) iret = objPop3.QUIT Set objPop3 = Nothing Exit Sub End If 'QUIT iret = objPop3.QUIT if iret <> 0 Then Call WriteError("QUIT", iret, objPop3) Set objSmtp = Nothing Exit Sub End If '終了 Set objPop3 = Nothing Wscript.Echo "LOGINに成功しました。" Exit Sub End Sub 'エラー内容を表示する Sub WriteError(strmethodname, iretcode, objPop3) Wscript.Echo "メソッド名:" & strmethodname Wscript.Echo "メソッド戻り値:" & iretcode Wscript.Echo "POP3返答メッセージ:" & objPop3.POP3msg Wscript.Echo "POP3返答拡張メッセージ:" & objPop3.POP3msgExt Wscript.Echo "Winsockエラーコード:" & objPop3.LastError End Sub