作成 2010.01.07
更新 2010.01.18
更新 2010.01.18
VBScript で DDNS を登録する
http://ieserver.net/ 用
タスクスケジューラに登録する場合は、10分間隔以上空けることを推奨
実際に登録が反映されるのに最大8分程度かかるため。
あと、Windows Server 2008 R2では最上位の特権で実行するをオンにしないとローカルファイルに書き込めないので改良の必要がある。
タスクスケジューラに登録する場合は、10分間隔以上空けることを推奨
実際に登録が反映されるのに最大8分程度かかるため。
あと、Windows Server 2008 R2では最上位の特権で実行するをオンにしないとローカルファイルに書き込めないので改良の必要がある。
Option Explicit Const USER_NAME = "user_name" Const DOMAIN_NAME = "domain_name" Const PASSWORD = "password" Const TIMEOUT = 10 Const REMOTE_CHECK = "http://ieserver.net/ipcheck.shtml" Const UPDATE_URL = "https://ieserver.net/cgi-bin/dip.cgi" Const PREV_FILE = "C:\temp\prev.txt" Const evError = 1 Const evInfo = 4 Const ForReading = 1 Const ForWriting = 2 Dim objIE, FSO, WshShell Dim countdown, CurText, PrevText Dim ChangeFlag, objFile, objRead, objWrite, objIPExp Set FSO = CreateObject("Scripting.FileSystemObject") Set WshShell = CreateObject("WScript.Shell") Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate REMOTE_CHECK countdown = TIMEOUT Do While objIE.Busy Or objIE.readystate <> 4 WScript.Sleep 1000 countdown = countdown - 1 If countdown <= 0 Then Exit Do Loop If countdown <= 0 Then WshShell.LogEvent evError, REMOTE_CHECK & " Timeout." objIE.Quit WScript.Quit End If CurText = objIE.Document.body.innerText Set objIPExp = New RegExp objIPExp.Pattern = "^\d+\.\d+\.\d+\.\d+$" objIPExp.Global = False objIPExp.IgnoreCase = False CurText = Trim(CurText) If Not objIPExp.Test(CurText) Then WshShell.LogEvent evError, "Check Error: " & CurText WScript.Quit End If ChangeFlag = False If Not FSO.FileExists( PREV_FILE ) Then PrevText = "Nothing" ChangeFlag = True Else Set objFile = FSO.GetFile( PREV_FILE ) If objFile.DateLastModified < Now - 1 Then PrevText = "Too Old" ChangeFlag = True Else Set objRead = FSO.OpenTextFile( PREV_FILE, ForReading ) PrevText = objRead.ReadAll objRead.Close If Not PrevText = CurText Then ChangeFlag = True End If End If End If If ChangeFlag Then objIE.Navigate UPDATE_URL & "?username=" & USER_NAME & "&domain=" & DOMAIN_NAME & _ "&password=" & PASSWORD & "&updatehost=1" countdown = TIMEOUT Do While objIE.Busy Or objIE.readystate <> 4 WScript.Sleep 1000 countdown = countdown - 1 If countdown <= 0 Then Exit Do Loop If countdown <= 0 Then WshShell.LogEvent evError, "Update Timeout " & PrevText & " => " & CurText ElseIf InStr(objIE.Document.body.innerText, CurText) > 0 Then WshShell.LogEvent evInfo, "Update " & PrevText & " => " & CurText & _ " Message:" & objIE.Document.body.innerText Set objWrite = FSO.OpenTextFile( PREV_FILE, ForWriting, True ) objWrite.Write CurText objWrite.Close Else WshShell.LogEvent evError, "Update Failed " & PrevText & " => " & CurText & _ " Message:" & objIE.Document.body.innerText End If Else WshShell.LogEvent evInfo, "Same IP " & CurText End If objIE.Quit Set objIE = Nothing