' ' DDNS更新ページをリクエストし、 ' IPアドレスに変更があった場合、イベントログ&メールするスクリプト ' (value domain版) ' ' author jomora@jomora.net (http://jomora.net/) ' ' version 2008.03.28 SMTP Auth対応 (POP before SMTP対応削除) ' version 2007.04.24 value domain用に改修 ' 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 作成 ' value domainのDDNS更新情報 Const ddnsHostname = "ddnsHostname" Const ddnsPassword = "********" ' IPアドレスに変更があったことをメールで通知するかどうか Const useMailAlertIPChanged = True Const smtpSrv = "smtp.jp.aol.com" Const smtpPort = 587 Const mailFrom = "mail@From" Const mailTo = "mail@To" ' IPアドレス変更メール通知の際、SMTP Authを利用するかどうか Const useSMTPAuth = True Const useSMTPSSL = False 'GmailならTrue Const sendUsername = "user@smtpauth" Const sendPassword = "********" ' 以下、変更の必要はないはず url = "http://dyn.value-domain.com/cgi-bin/dyn.fcg?d=" & ddnsHostname & "&p=" & ddnsPassword & "&h=*" '**Start Encode** ' メインルーチン 'WScript.StdOut.WriteLine "-----" & now() oldIP = GetIPFromNSLookup(ddnsHostname) WScript.StdOut.WriteLine "oldIP : " & oldIP ddnsResponseText = GetDDNSResponseText() WScript.StdOut.Write ddnsResponseText WScript.Sleep 540000 newIP = GetIPFromNSLookup(ddnsHostname) WScript.StdOut.WriteLine "newIP : " & newIP 'IPアドレスに更新があった場合通知 If oldIP <> newIP Then Call PrintLog(4, "[DDNS] IPアドレス更新(" & newIP & ")", ddnsResponseText & vbCrLf & oldIP & " -> " & newIP, True) End If WScript.Quit ' 以下サブルーチン Function GetDDNSResponseText() GetDDNSResponseText = "" 'DDNS更新ページを一時ファイルとしてバイナリ形式でダウンロード Set objHTTP = WScript.CreateObject("MSXML2.ServerXMLHTTP") objHTTP.Open "GET", url, False, False, False objHTTP.setTimeouts 3000, 3000, 3000, 30000 'ServerXMLHTTP利用時 objHTTP.Send If objHTTP.status <> 200 Then Call PrintLog(2, "[DDNS] 結果の取得に失敗しました (HTTP STATUS:" & objHTTP.status & ")", ddnsResponseText, False) WScript.Quit(1) End If GetDDNSResponseText = objHTTP.responseText If GetDDNSResponseText = "" Then Call PrintLog(1, "[DDNS] レスポンスが null です", ddnsResponseText, False) WScript.Quit(1) End If End Function Function GetIPFromNSLookup(hostname) GetIPFromNSLookup = "" line_all = "" 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() line_all = line_all & line & vbCrLf If regEx.Test(line) Then GetIPFromNSLookup = Split(line, " ")(2) End If Loop If 1 = Instr(GetIPFromNSLookup, "192.168.") Then Call PrintLog(1, "[DDNS] IP取得に失敗しました", line_all, False) WScript.Quit(1) End If End Function ' IPアドレス変更結果出力 Sub PrintLog(status, title, message, sendMail) WScript.StdOut.WriteLine title & vbCrLf & message 'イベントログに記録 Set objShell = CreateObject("WScript.Shell") Call objShell.LogEvent(status, title & vbCrLf & message) 'メール送信 If useMailAlertIPChanged And sendMail Then Call SMTPSend(title, message) End If End Sub Sub SMTPSend(subject, mailBody) 'メール送信 Set oMsg = CreateObject("CDO.Message") schemas = "http://schemas.microsoft.com/cdo/configuration/" oMsg.Configuration.Fields.Item (schemas & "sendusing") = 2 ' oMsg.Configuration.Fields.Item (schemas & "languagecode") = "iso-2022-jp" oMsg.Configuration.Fields.Item (schemas & "smtpserver") = smtpSrv oMsg.Configuration.Fields.Item (schemas & "smtpauthenticate") = useSMTPAuth oMsg.Configuration.Fields.Item (schemas & "sendusername") = sendUsername oMsg.Configuration.Fields.Item (schemas & "sendpassword") = sendPassword oMsg.Configuration.Fields.Item (schemas & "smtpserverport") = smtpPort oMsg.Configuration.Fields.Item (schemas & "smtpusessl") = useSMTPSSL oMsg.Configuration.Fields.Update ' oMsg.MimeFormatted = True oMsg.Fields.Item("urn:schemas:mailheader:X-Mailer") = "ddnsUpdate.vbs" oMsg.Fields.Update() oMsg.From = mailFrom oMsg.To = mailTo oMsg.Subject = subject oMsg.BodyPart.Charset = "ISO-2022-JP" oMsg.TextBody = mailBody ' oMsg.TextBodyPart.Charset = "ISO-2022-JP" oMsg.Send Set oMsg = Nothing Wscript.Echo "メールを送信しました。" End Sub