三个角(含)以下的UP请到
http://expert.csdn.net/Expert/topic/1701/1701935.xml?temp=.7192804
领散分.
form中加一个Command,代码如下
Private Sub Command1_Click()
 Dim error As Long
    Dim FixedInfoSize As Long
    Dim AdapterInfoSize As Long
    Dim i As Integer
    Dim PhysicalAddress  As String
    Dim NewTime As Date
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim AddrStr As IP_ADDR_STRING
    Dim FixedInfo As FIXED_INFO
    Dim Buffer As IP_ADDR_STRING
    Dim pAddrStr As Long
    Dim pAdapt As Long
    Dim Buffer2 As IP_ADAPTER_INFO
    Dim FixedInfoBuffer() As Byte
    Dim AdapterInfoBuffer() As Byte
    
    ' Get the main IP configuration information for this machine
    ' using a FIXED_INFO structure.
    FixedInfoSize = 0
    error = GetNetworkParams(ByVal 0&, FixedInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
           MsgBox "GetNetworkParams sizing failed with error " & error
           Exit Sub
        End If
    End If
    ReDim FixedInfoBuffer(FixedInfoSize - 1)
    
    error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
    If error = 0 Then
            CopyMemory FixedInfo, FixedInfoBuffer(0), FixedInfoSize
            MsgBox "Host Name:  " & FixedInfo.HostName
            MsgBox "DNS Servers:  " & FixedInfo.DnsServerList.IpAddress
            pAddrStr = FixedInfo.DnsServerList.Next
            Do While pAddrStr <> 0
                  CopyMemory Buffer, ByVal pAddrStr, LenB(Buffer)
                  MsgBox "DNS Servers:  " & Buffer.IpAddress
                  pAddrStr = Buffer.Next
            Loop
            
            Select Case FixedInfo.NodeType
                       Case 1
                                  MsgBox "Node type: Broadcast"
                       Case 2
                                  MsgBox "Node type: Peer to peer"
                       Case 4
                                  MsgBox "Node type: Mixed"
                       Case 8
                                  MsgBox "Node type: Hybrid"
                       Case Else
                                  MsgBox "Unknown node type"
            End Select
            
            MsgBox "NetBIOS Scope ID:  " & FixedInfo.ScopeId
            If FixedInfo.EnableRouting Then
                       MsgBox "IP Routing Enabled "
            Else
                       MsgBox "IP Routing not enabled"
            End If
            If FixedInfo.EnableProxy Then
                       MsgBox "WINS Proxy Enabled "
            Else
                       MsgBox "WINS Proxy not Enabled "
            End If
            If FixedInfo.EnableDns Then
                      MsgBox "NetBIOS Resolution Uses DNS "
            Else
                      MsgBox "NetBIOS Resolution Does not use DNS  "
            End If
    Else
            MsgBox "GetNetworkParams failed with error " & error
            Exit Sub
    End If
    
    ' Enumerate all of the adapter specific information using the
    ' IP_ADAPTER_INFO structure.
    ' Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
    
    AdapterInfoSize = 0
    error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
           MsgBox "GetAdaptersInfo sizing failed with error " & error
           Exit Sub
        End If
    End If
    ReDim AdapterInfoBuffer(AdapterInfoSize - 1)    ' Get actual adapter information
    error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
    If error <> 0 Then
       MsgBox "GetAdaptersInfo failed with error " & error
       Exit Sub
    End If
   
    ' Allocate memory
     CopyMemory AdapterInfo, AdapterInfoBuffer(0), AdapterInfoSize
    pAdapt = AdapterInfo.Next    Do
     CopyMemory Buffer2, AdapterInfo, AdapterInfoSize
       Select Case Buffer2.Type
              Case MIB_IF_TYPE_ETHERNET
                   MsgBox "Adapter name: Ethernet adapter "
              Case MIB_IF_TYPE_TOKENRING
                   MsgBox "Adapter name: Token Ring adapter "
              Case MIB_IF_TYPE_FDDI
                   MsgBox "Adapter name: FDDI adapter "
              Case MIB_IF_TYPE_PPP
                   MsgBox "Adapter name: PPP adapter"
              Case MIB_IF_TYPE_LOOPBACK
                   MsgBox "Adapter name: Loopback adapter "
              Case MIB_IF_TYPE_SLIP
                   MsgBox "Adapter name: Slip adapter "
              Case Else
                   MsgBox "Adapter name: Other adapter "
       End Select
       MsgBox "AdapterDescription: " & Buffer2.Description       PhysicalAddress = ""
       For i = 0 To Buffer2.AddressLength - 1
           PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
           If i < Buffer2.AddressLength - 1 Then
              PhysicalAddress = PhysicalAddress & "-"
           End If
       Next
       MsgBox "Physical Address: " & PhysicalAddress
    
       If Buffer2.DhcpEnabled Then
          MsgBox "DHCP Enabled "
       Else
          MsgBox "DHCP disabled"
       End If       MsgBox "IP Address: " & Buffer2.IpAddressList.IpAddress
       MsgBox "Subnet Mask: " & Buffer2.IpAddressList.IpMask
       pAddrStr = Buffer2.IpAddressList.Next
       Do While pAddrStr <> 0
          CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
          MsgBox "IP Address: " & Buffer.IpAddress
          MsgBox "Subnet Mask: " & Buffer.IpMask
          pAddrStr = Buffer.Next
          If pAddrStr <> 0 Then
             CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, _
                        LenB(Buffer2.IpAddressList)
          End If
       Loop
    
       MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress
       pAddrStr = Buffer2.GatewayList.Next
       Do While pAddrStr <> 0
          CopyMemory Buffer, Buffer2.GatewayList, LenB(Buffer)
          MsgBox "IP Address: " & Buffer.IpAddress
          pAddrStr = Buffer.Next
          If pAddrStr <> 0 Then
             CopyMemory Buffer2.GatewayList, ByVal pAddrStr, _
                        LenB(Buffer2.GatewayList)
          End If
       Loop       MsgBox "DHCP Server: " & Buffer2.DhcpServer.IpAddress
       MsgBox "Primary WINS Server: " & _
              Buffer2.PrimaryWinsServer.IpAddress
       MsgBox "Secondary WINS Server: " & _
              Buffer2.SecondaryWinsServer.IpAddress       ' Display time.
       NewTime = DateAdd("s", Buffer2.LeaseObtained, #1/1/1970#)
       MsgBox "Lease Obtained: " & _
              CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy"))
     
       NewTime = DateAdd("s", Buffer2.LeaseExpires, #1/1/1970#)
       MsgBox "Lease Expires :  " & _
              CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy"))
       pAdapt = Buffer2.Next
       If pAdapt <> 0 Then
           CopyMemory AdapterInfo, ByVal pAdapt, AdapterInfoSize
        End If
      Loop Until pAdapt = 0End Sub

解决方案 »

  1.   


    =========================把下面代码放在模块中===========================
    Option ExplicitPublic Const MAX_HOSTNAME_LEN = 132
    Public Const MAX_DOMAIN_NAME_LEN = 132
    Public Const MAX_SCOPE_ID_LEN = 260
    Public Const MAX_ADAPTER_NAME_LENGTH = 260
    Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
    Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
    Public Const ERROR_BUFFER_OVERFLOW = 111
    Public Const MIB_IF_TYPE_ETHERNET = 6
    Public Const MIB_IF_TYPE_TOKENRING = 9
    Public Const MIB_IF_TYPE_FDDI = 15
    Public Const MIB_IF_TYPE_PPP = 23
    Public Const MIB_IF_TYPE_LOOPBACK = 24
    Public Const MIB_IF_TYPE_SLIP = 28Type IP_ADDR_STRING
                Next As Long
                IpAddress As String * 16
                IpMask As String * 16
                Context As Long
    End TypeType IP_ADAPTER_INFO
                Next As Long
                ComboIndex As Long
                AdapterName As String * MAX_ADAPTER_NAME_LENGTH
                Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
                AddressLength As Long
                Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
                Index As Long
                Type As Long
                DhcpEnabled As Long
                CurrentIpAddress As Long
                IpAddressList As IP_ADDR_STRING
                GatewayList As IP_ADDR_STRING
                DhcpServer As IP_ADDR_STRING
                HaveWins As Byte
                PrimaryWinsServer As IP_ADDR_STRING
                SecondaryWinsServer As IP_ADDR_STRING
                LeaseObtained As Long
                LeaseExpires As Long
    End TypeType FIXED_INFO
                HostName As String * MAX_HOSTNAME_LEN
                DomainName As String * MAX_DOMAIN_NAME_LEN
                CurrentDnsServer As Long
                DnsServerList As IP_ADDR_STRING
                NodeType As Long
                ScopeId  As String * MAX_SCOPE_ID_LEN
                EnableRouting As Long
                EnableProxy As Long
                EnableDns As Long
    End TypePublic Declare Function GetNetworkParams Lib "IPHlpApi.dll" _
           (FixedInfo As Any, pOutBufLen As Long) As Long
    Public Declare Function GetAdaptersInfo Lib "IPHlpApi.dll" _
           (IpAdapterInfo As Any, pOutBufLen As Long) As Long
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
           (Destination As Any, Source As Any, ByVal Length As Long)
      

  2.   

    请问高手,为什么?这个部分MsgBox "IP Address: " & Buffer.IpAddress我用if Buffer.IpAddress=text1.text 时会产生严重的错误连vb都点关闭呢?
    他Buffer.IpAddress是string为什么text控件不能显示呢? 真奇怪!,呵呵
      

  3.   

    Buffer.IpAddress运行后msgbox显示为没有,为什么if Buffer.IpAddress=“”总是假啊!Buffer.IpAddress的值到底是什么那!请帮助小弟一下吧!
      

  4.   


           MsgBox "IP Address: " & Buffer2.IpAddressList.IpAddress
           Text1.Text = Buffer2.IpAddressList.IpAddress这一段比较适合,得到全部的网络置,如果你只要一个IP
    可以用其他的API