タグ
  ANSI (1)
  ASP.NET (10)
  Active Directory (55)
  BAT (16)
  Backup (2)
  CSharp (11)
  CentOS (4)
  C言語 (4)
  DNS (4)
  Excel (2)
  FFmpeg (1)
  Fedora (4)
  FreeBSD (6)
  IPv6 (3)
  Java (11)
  JavaScript (8)
  LAN (1)
  Link (4)
  Linux (15)
  Mac (1)
  Mail (2)
  Microsoft (3)
  NIS (1)
  Node.js (6)
  OpenIndiana (1)
  OpenLDAP (2)
  OpenSSL (1)
  OpenSolaris (4)
  PHP (2)
  Perl (2)
  Postfix (1)
  PostgreSQL (2)
  PowerShell (34)
  RFC (3)
  SQL Server (5)
  Solaris (10)
  Ubuntu (9)
  VBScript (73)
  VCpp (2)
  VMware (3)
  Visual Basic (1)
  WMI (17)
  WSF (5)
  WSH (10)
  Windows (19)
  bash (1)
  bind (1)
  iSCSI (1)
  作成中 (8)
  慣用句 (3)
  正規表現 (6)
  運用 (8)
作成 2010.01.07
更新 2010.01.18
VBScript で DDNS を登録する
http://ieserver.net/
タスクスケジューラに登録する場合は、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
タグ: VBScript DNS
[リロード] [記事修正] [新規作成] [使用方法]
©2004-2012 UPKEN IPv4