作成 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