' DNS リゾルバの変更
' 動作仕様
'   動作確認OS
'	Windows 2000 Professional SP4
'       Windows XP Professional SP3
'   基本機能
'	プライベートIPアドレスのNICのDNSリゾルバを変更します。
'   以下の状態であればエラーメッセージを出して終了します
'	DNS の変更権限がない場合
'	DHCP が有効のNICしか見つからない場合
'	DNS リゾルバが設定済みの場合
'	プライベートIPアドレスが設定されているNICが１つも見つからない場合
'	複数IPアドレスが設定されているNICで、ひとつでもプライベートIPアドレスでない場合
'   その他
'	複数NICが存在する可能性を想定しています。（無線、有線のノートパソコンなど）
'	ひとつのNICで複数IPアドレスがある可能性を想定しています。
'	複数NICがある場合で、プライベートアドレスのみのNICは全て設定します。
'	IPv6 は想定していません。
'	無効化しているNICは無視します。

' //////////////////////////////////
Option Explicit

' 設定するDNSサーバーアドレス
Const DNS_SERVERS = "192.168.0.10,192.168.10.10"

' //////////////////////////////////
' DHCP が有効だったら停止
Const STOP_ON_DHCP = True

' IPv6 は無視
Const IGNORE_IPV6 = True

' //////////////////////////////////
Const WMI_QUERY = "Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = TRUE"
Dim wmiLocator
Dim wmiService
Dim objEnumerator
Dim objInstance
Dim arrayDNS
Dim newDNS_SERVERS
Dim oldDNS_SERVERS
Dim strAddress
Dim strDNS
Dim dnsCount
Dim dnsMismatch
Dim IsDhcp
Dim IsComplete
Dim IsPrivate
Dim IsGlobal
Dim AnError
Dim IsAlreadySet

Set wmiLocator = CreateObject("WbemScripting.SWbemLocator")
Set wmiService = wmiLocator.ConnectServer
IsDhcp = False
IsComplete = False
IsGlobal = False
AnError = 0
IsAlreadySet = False
arrayDNS = Split(DNS_SERVERS, ",")
newDNS_SERVERS = ""

' DNS_SERVERS の整形
For dnsCount = 0 To UBound(arrayDNS)
  strDNS = Trim(arrayDNS(dnsCount))
  If Len(strDNS) > 0 Then
    If dnsCount = 0 Then
      newDNS_SERVERS = strDNS
    Else
      newDNS_SERVERS = newDNS_SERVERS & "," & strDNS
    End If
  End If
Next
arrayDNS = Split(newDNS_SERVERS, ",")

' 設定するNICの検出
Set objEnumerator = wmiService.ExecQuery(WMI_QUERY)
For Each objInstance In objEnumerator
  If STOP_ON_DHCP And objInstance.DHCPEnabled Then
    IsDhcp = True
  Else
    ' WScript.Echo objInstance.Index
    IsPrivate = True
    For Each strAddress In objInstance.IPAddress
      If Len(strAddress) < 1 Then IsPrivate = False
      If Not IsPrivateAddress(strAddress) Then IsPrivate = False
    Next
    If IsPrivate Then
      ' DNS が設定済みか確認する
      dnsCount = 0
      dnsMismatch = False
      oldDNS_SERVERS = ""
      On Error Resume Next
      For Each strDNS In objInstance.DNSServerSearchOrder
        If dnsCount = 0 Then
          oldDNS_SERVERS = Trim(strDNS)
        Else
          oldDNS_SERVERS = oldDNS_SERVERS & "," & Trim(strDNS)
        End If
        dnsCount = dnsCount + 1
      Next
      If Err.Number <> 0 Then ' DNSの設定が無ければ該当する
        dnsMismatch = True
      ElseIf Not oldDNS_SERVERS = newDNS_SERVERS Then
        dnsMismatch = True
      End If
      On Error Goto 0
      If dnsMismatch Then
        ' DNS リゾルバを設定する
        AnError = objInstance.SetDNSServerSearchOrder(arrayDNS)
        If AnError = 0 Then IsComplete = True
      Else
        IsComplete = True
        IsAlreadySet = True
      End If
    Else
      IsGlobal = True
    End If
  End If
Next
If IsComplete Then
  If IsAlreadySet Then
    WScript.Echo "このコンピュータは設定済みです。"
  Else
    WScript.Echo "設定終了しました。"
  End If
ElseIf AnError <> 0 Then
  WScript.Echo "エラーが発生しました。設定する権限が無いようです"
ElseIf IsDhcp Then
  WScript.Echo "DHCPのため設定しませんでした"
ElseIf IsGlobal Then
  WScript.Echo "プライベートIPが見つからなかったため設定しませんでした"
Else
  WScript.Echo "NICが見つかりませんでした。"
End If

' プライベートアドレスか判断する
' プライベートアドレスだったら True
Function IsPrivateAddress(strAddress)
  Dim returnValue
  Dim regEx
  Dim Matches
  Dim Match
  Dim intA(2)
  Dim count

  returnValue = False
  Set regEx = New RegExp
  regEx.Pattern = "^\d+\.\d+\.\d+\.\d+$"
  regEx.Global = False
  regEx.IgnoreCase = False

  If regEx.Test(strAddress) Then
    regEx.Pattern = "\d+"
    regEx.Global = True
    Set Matches = regEx.Execute(strAddress)
    count = 0
    For Each Match In Matches
      intA(count) = CInt(Match)
      count = count + 1
      If count >= 2 Then Exit For
    Next
    If intA(0) = 10 Then
      returnValue = True
    ElseIf intA(0) = 172 And intA(1) >= 16 And intA(1) < 32 Then
      returnValue = True
    ElseIf intA(0) = 192 And intA(1) = 168 Then
      returnValue = True
    End If
  Else
    If IGNORE_IPV6 Then ' IPv6 は判断しない
      returnValue = True
    Else
      ' fe8,fe9,fea,feb,fc,fd がプライベートアドレス
      regEx.Pattern = "^f(e8|e9|ea|eb|c|d)"
      regEx.IgnoreCase = True
      If regEx.Test(strAddress) Then
        returnValue = True
      End If
    End If
  End If

  IsPrivateAddress = returnValue
End Function

• 2010/02/21 既存のプライマリDNSが同じで新しいDNSの方が数が多いと更新されない問題を修正