[Visual Basic] 纯文本查看 复制代码
strComputer = "."
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/cimv2")
Do
strIP = InputBox("请输入IP地址", "IP地址修改器", "192.168.118.111")
If strIP = False Then Wscript.Quit
Loop Until ValidateIP(strIP)
strDNS1 = "1.2.4.8"
strDNS2 = "1.1.1.1"
a = Split(strIP, ".")(2)
If a = "118" Or a = "119" Then
strMask = "255.255.254.0"
strGW = "192.168.119.254"
Else
strMask = "255.255.255.0"
strGW = Left(strIP, InStrRev(strIP, ".") - 1) & ".254"
End If
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=true")
For Each objItem in colItems
If (InStr(objItem.Description, "PCI") > 0) Then MAC = objItem.MACAddress
Next
Set colNetAdapters = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where MACAddress='" & MAC & "'")
For Each objNetAdapter In colNetAdapters
AdapterGUID = objNetAdapter.SettingID
Exit For
Next
If ChangeNetworkConfig(objWMIService, strIP, strMask, strGW, strDNS1, strDNS2, MAC) Then
MsgBox "IP地址已更改。", 64, "IP地址修改器"
Else
RegBasePaths = Array("SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & AdapterGUID, _
"SYSTEM\ControlSet001\Services\Tcpip\Parameters\Interfaces\" & AdapterGUID, _
"SYSTEM\ControlSet002\Services\Tcpip\Parameters\Interfaces\" & AdapterGUID)
For Each RegBasePath in RegBasePaths
Msg = Msg & vbCrLF & ChangeIPWithREG(RegBasePath, strIP, strMask, strGW, strDNS1, strDNS2)
Next
MsgBox Msg, 64, "IP地址修改器"
End If
Function ValidateIP(strIP)
Set re = New Regexp
re.Pattern = "^192\.168\.(?:11[2-9]|12[0-7])\.(?:25[0-5]|2[0-4][0-9]|1[0-9]{2}|[1-9]?[0-9])$"
re.IgnoreCase = True
re.Global = True
ValidateIP = re.Test(strIP)
If Not ValidateIP Then MsgBox "地址非法", 16, "IP地址修改器"
End Function
Function ChangeNetworkConfig(objWMIService, strIP, strMask, strGW, strDNS1, strDNS2, MAC)
Set colNetAdapters = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where MACAddress='" & MAC & "'")
strIPAddress = Array(strIP)
strSubnetMask = Array(strMask)
strGateway = Array(strGW)
strGatewayMetric = Array(1)
arrDNSServers = Array(strDNS1, strDNS2)
For Each objNetAdapter In colNetAdapters
errEnable = objNetAdapter.EnableStatic(strIPAddress, strSubnetMask)
errGateways = objNetAdapter.SetGateways(strGateway, strGatewayMetric)
errDNS = objNetAdapter.SetDNSServerSearchOrder(arrDNSServers)
If errEnable = 0 And errGateways = 0 Then
ChangeNetworkConfig = True
Exit Function
End If
Next
ChangeNetworkConfig = False
End Function
Function ChangeIPWithREG(sPath, IPAddress, SubnetMask, Gateway, DNS1, DNS2)
hKey = &H80000002
Set objWMIService = GetObject("winmgmts:\\.\root\default:StdRegProv")
v1 = objWMIService.SetMultiStringValue(hKey, sPath, "IPAddress", Array(IPAddress))
v2 = objWMIService.SetMultiStringValue(hKey, sPath, "SubnetMask", Array(SubnetMask))
v3 = objWMIService.SetMultiStringValue(hKey, sPath, "DefaultGateway", Array(Gateway))
v4 = objWMIService.SetStringValue(hKey, sPath, "NameServer", DNS1 & "," & DNS2)
If v1 = 0 And v2 = 0 And v3 = 0 And v4 = 0 Then
ChangeIPWithREG = "IP设置成功,重启电脑后生效。"
Else
ChangeIPWithREG = "IP配置设置失败。"
End If
End Function