修改电脑IP地址

来源:互联网 发布:淘宝综合排名突然下降 编辑:程序博客网 时间:2024/04/28 20:47

读取网卡信息

Option Explicit   
Dim objSWbemServices As SWbemServices   
Dim objSWbemObjectSet As SWbemObjectSet   
Dim objSWbemObject As SWbemObject   
Private Type NetCard   
    Name As String  
    IPAdress As String  
    IpSubNets As String  
    IpGateWay As String  
    DnsString0 As String  
    DnsString1 As String  
    MacAdress As String  
End Type   
Dim MtNetCard() As NetCard   
Private Sub Command1_Click()   
    Dim i As Long  
    For i = LBound(MtNetCard) To UBound(MtNetCard) - 1   
        Text1 = Text1 & "网卡:    " & MtNetCard(i).Name & vbNewLine   
        Text1 = Text1 & "ip地址:  " & MtNetCard(i).IPAdress & vbNewLine   
        Text1 = Text1 & "子网掩码:" & MtNetCard(i).IpSubNets & vbNewLine   
        Text1 = Text1 & "网关:    " & MtNetCard(i).IpGateWay & vbNewLine   
        Text1 = Text1 & "DNS1:     " & MtNetCard(i).DnsString0 & vbNewLine   
        Text1 = Text1 & "DNS2:     " & MtNetCard(i).DnsString1 & vbNewLine   
        Text1 = Text1 & "MAC:     " & MtNetCard(i).MacAdress & vbNewLine   
    Next  
    Erase MtNetCard   
End Sub  
  
Private Sub Form_Load()   
    ReDim MtNetCard(0) As NetCard   
    Set objSWbemServices = GetObject("winmgmts:")   
    Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")   
    For Each objSWbemObject In objSWbemObjectSet   
        On Error Resume Next  
        MtNetCard(UBound(MtNetCard)).Name = objSWbemObject.Description   '添加本机上已经安装了TCP/IP协议的网卡   
        MtNetCard(UBound(MtNetCard)).IPAdress = objSWbemObject.IPAddress(0)   
        MtNetCard(UBound(MtNetCard)).IpSubNets = objSWbemObject.IPSubnet(0)   
        MtNetCard(UBound(MtNetCard)).IpGateWay = objSWbemObject.DefaultIPGateway(0)   
        MtNetCard(UBound(MtNetCard)).DnsString0 = objSWbemObject.DNSServerSearchOrder(0)   
        MtNetCard(UBound(MtNetCard)).DnsString1 = objSWbemObject.DNSServerSearchOrder(1)   
        MtNetCard(UBound(MtNetCard)).MacAdress = objSWbemObject.MacAddress(0)   
        ReDim Preserve MtNetCard(UBound(MtNetCard) + 1) As NetCard   
    Next  
End Sub