'
' 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