'
' DDNS更新ページをリクエストし、
' IPアドレスに変更があった場合、ログ＆メールするスクリプト
'
' author Jomora(http://jomora.bne.jp/)
' version 2005.06.05 作成
' version 2005.06.21 ServerXMLHTTPに変更、setTimeoutsを追加
' version 2005.10.03 POP before SMTP 対応

Const url = "http://ddns.j-speed.net/quickUpdate.jsp?uparams=server,********,name.jp,********" 'J-SpeedのDDNS更新ページ

Const smtpSrv = "smtp.server"
Const mailFrom = "mail@from"
Const mailTo = "mail@to" '連絡先メールアドレス

Const popSrv = "pop.server"
Const popUsername = "username"
Const popPassword = "password"

'**Start Encode**

'一時ファイル名の生成
Set objFs = WScript.CreateObject("Scripting.FileSystemObject")
tempFileName = objFs.GetTempName

'DDNS更新ページを一時ファイルとしてバイナリ形式でダウンロード
'Set objHTTP = WScript.CreateObject("Microsoft.XMLHTTP")
Set objHTTP = WScript.CreateObject("MSXML2.ServerXMLHTTP")
'Set objHTTP = WScript.CreateObject("MSXML2.ServerXMLHTTP.4.0")
objHTTP.Open "GET", url, False
objHTTP.setTimeouts 3000, 3000, 3000, 30000 'ServerXMLHTTP利用時
objHTTP.Send
Set stream = WScript.CreateObject("Adodb.Stream")
stream.Type = 1 'adTypeBinary=1, adTypeText=2
stream.Open 
stream.Write objHTTP.responseBody
stream.Savetofile tempFileName, 2 'adSaveCreateNotExist=1, adSaveCreateOverWrite=2
stream.Close

'一時ファイルをテキスト読み込み、行検索
Set tempFile = objFs.OpenTextFile(tempFileName)
Set regEx = New RegExp
regEx.Pattern = "IPアドレスを "
log_message = ""
Do Until tempFile.AtEndOfStream
    tempLine = tempFile.ReadLine
    If regEx.Test(tempLine) Then
        log_message = tempLine
        Exit Do
    End If
Loop
tempFile.Close

'IPアドレスに更新があった場合通知
If log_message <> "" Then
    Call PrintLog(log_message)
End If

'一時ファイルの削除
objFs.DeleteFile tempFileName


' ログ出力関数
Sub PrintLog(message)
    WScript.Echo message

    'イベントログに記録
    Set objShell = CreateObject("WScript.Shell")
    Call objShell.LogEvent(0, message)

    'メール送信
	Call POP3Login(popSrv, popUsername, popPassword)
	Call SMTPSend(smtpSrv, mailFrom, mailTo, message)
End Sub

Sub SMTPSend(smtpSrv, mailFrom, mailTo, mailBody)
    'メール送信
    Set oMsg = CreateObject("CDO.Message")
    oMsg.From = mailFrom
    oMsg.To = mailTo
    oMsg.Subject = "[DDNS] IPアドレスが更新されました。"
    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
