'
' DDNS更新ページをリクエストし、
' IPアドレスに変更があった場合、イベントログ＆メールするスクリプト
' (value domain版)
'
' author jomora@jomora.net (http://jomora.net/)
'
' version 2009.09.04 DDNS情報をコマンドライン引数化
' version 2008.03.29 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更新情報
Set objArgs=WScript.Arguments.Unnamed
If objArgs.Count < 2 Then
	WScript.StdOut.WriteLine "ddnsHostnameとddnsPasswordを、引数で指定してください。"
	WScript.Quit(1)
End If
ddnsHostname = objArgs.Item(0) '"jomura.net"
ddnsPassword = objArgs.Item(1) '"********"

' IPアドレスに変更があったことをメールで通知するかどうか
Const useMailAlertIPChanged = True
Const smtpSrv = "smtp.gyao.ne.jp"
Const smtpPort = 587
Const mailFrom = "mailaddress"
Const mailTo = "mailaddress"

' IPアドレス変更メール通知の際、SMTP Authを利用するかどうか
Const useSMTPAuth = True
Const useSMTPSSL = False
Const sendUsername = "mailaddress"
Const sendPassword = "********"


' 以下、変更の必要はないはず
url = "http://dyn.value-domain.com/cgi-bin/dyn.fcg?d=" & ddnsHostname & "&p=" & ddnsPassword & "&h=*"

'**Start Encode**

' メインルーチン
'WScript.StdOut.WriteLine "-----" & now()

'旧IPアドレスを取得
oldIP = GetIPFromNSLookup(ddnsHostname)
WScript.StdOut.WriteLine "oldIP : " & oldIP

'DDNS更新
ddnsResponseText = GetDDNSResponseText()
WScript.StdOut.Write ddnsResponseText

'570秒待つ
WScript.Sleep 570000

'新IPアドレスを取得
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