在菜单中的【工程】—【引用】下，添加“Microsoft WMI Scripting V1.1 Library”，然后在Form1窗体上添加1个Combo1、Text1(0)、Text1(1)、Text1(2)、Text1(3)和Command1、Command2，代码如下：
Private Const FLAG_ICC_FORCE_CONNECTION = &H1
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" _
(ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Option Explicit
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
'Text1(0)为IP地址、Text1(1)为子网掩码、Text1(2)为缺省网关、Text1(3)为DNS、 Text3.Text = objSWbemObject.MACAddress(0) MAC地址
Private Sub Command3_Click()
If InternetCheckConnection("http://www.baidu.com", FLAG_ICC_FORCE_CONNECTION, 0&) = 0 Then
MsgBox "网络连接失败，请检查IP是否冲突！", vbCritical
Else
MsgBox "恭喜，网络正常！"
End If
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Text1(1).Visible = False
Text1(2).Visible = False
Text1(3).Visible = False
Text2.Visible = False
Set objSWbemServices = GetObject("winmgmts:")
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each objSWbemObject In objSWbemObjectSet
Combo1.AddItem objSWbemObject.Description '添加本机上已经安装了TCP/IP协议的网卡
Next
Combo1.Text = Combo1.List(0)
Combo1.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objSWbemServices = Nothing
Set objSWbemObjectSet = Nothing
Set objSWbemObject = Nothing
End Sub
'当选择了网卡后，显示当前所选网卡的设置
Private Sub Combo1_Click()
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
For Each objSWbemObject In objSWbemObjectSet
If objSWbemObject.DHCPEnabled Then
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
If IsNull(objSWbemObject.DNSServerSearchOrder) Then
Text1(3).Text = ""
Else
Text1(3).Text = objSWbemObject.DNSServerSearchOrder(0)
End If
Else
Text1(0).Text = objSWbemObject.IPAddress(0)
Text1(1).Text = objSWbemObject.IPSubnet(0)
Text3.Text = Replace(objSWbemObject.MACAddress(0), ":", "-")
End If
Next
End Sub
'设置网卡的IP地址、子网掩码、缺省网关和DNS
Private Sub Command1_Click()
Timer1.Enabled = True
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
For Each objSWbemObject In objSWbemObjectSet
objSWbemObject.EnableStatic Array(Text1(0).Text), Array(Text1(1).Text)
objSWbemObject.SetGateways Array(Text1(2).Text)
objSWbemObject.SetDNSServerSearchOrder Array(Text1(3).Text)
Next
Shell "cmd.exe /c arp -s " & Text1(0).Text & " " & Text3.Text, vbHide
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Timer1_Timer()
Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where Description='" & Combo1.Text & "'")
For Each objSWbemObject In objSWbemObjectSet
If objSWbemObject.DHCPEnabled Then
Text2.Text = ""
Else
Text2.Text = objSWbemObject.IPAddress(0)
End If
Next
If Text2.Text = Text1(0).Text Then
MsgBox "IP设置成功" & " " & "新IP:" & Text2.Text & vbCrLf & "MAC：" & Text3.Text & " " & "已复制" & vbCrLf & Text2.Text & " " & Text3.Text & " " & "已绑定", vbOKOnly, "BY:联系科技"
'Shell "cmd.exe /c arp -d", vbHide
Shell "cmd.exe /c arp -s " & Text1(0).Text & " " & Text3.Text, vbHide
Clipboard.Clear
Clipboard.SetText Text3.Text
Timer1.Enabled = False
End If
End Sub