[VBnet Network] GetAdaptersInfo: Get the Network Adapter IP Address

	Visual Basic Network Services GetAdaptersInfo: Get the Network Adapter IP Address

Posted:	Wednesday April 25, 2001
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows 2000
OS restrictions:	Windows 98, Windows 2000, Windows XP
Author:	VBnet - Randy Birch

Related:	GetAdaptersInfo: Determine if DHCP is Enabled GetAdaptersInfo: Get the DHCP Server IP GetAdaptersInfo: Get the IPs for all DHCP Servers GetAdaptersInfo: Get the Network Adapter IP Address GetAdaptersInfo: Get IP Addresses for All Installed Network Adapters GetNetworkParams: Determine Current and Available DNS Servers

Prerequisites

One of the operating systems listed under OS Restrictions above.

The IP_ADAPTER_INFO type returned from GetAdaptersInfo contains byte array representing the sIPAddress of the installed network card. By retrieving the pointer to the sIPAddress member, the local IP for the net card can be returned.

GetAdaptersInfo is used in the LocalIPAddress function to return the address of the first network card installed.

Note that my system uses a LinkSys DSL Router to provide both DHCP and firewall capabilities, so internally the returned addresses are all in the 192.168.1.xxx range.

If the system has multiple network cards, the code below only returns the IP of the first card found. To enumerate the addresses of all active cards in the machine use the companion routine GetAdaptersInfo: Get IP Addresses for All Installed Network Adapters.

Note that when the a machine is behind a router the IP presented to the public is not that of the physical network card. When you need to know the public IP you have to resort on ASP code running on a page outside the router to return this address. I've got such a page set up, and you are free to access it through your code. See URLDownloadToFile: Obtain Machine's Public IP Behind Router.

BAS Module Code

None.

Form Code

To a form add a command button (Command1), and a Text box (Text1). Add the following to the form:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const ERROR_SUCCESS As Long = 0

Private Type IP_ADDRESS_STRING
   IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
   IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
   dwNext As Long
   IpAddress As IP_ADDRESS_STRING
   IpMask As IP_MASK_STRING
   dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
   dwNext As Long
   ComboIndex As Long  'reserved
   sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
   sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
   dwAddressLength As Long
   sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
   dwIndex As Long
   uType As Long
   uDhcpEnabled As Long
   CurrentIpAddress s Long
   IpAddressList As IP_ADDR_STRING
   GatewayList As IP_ADDR_STRING
   DhcpServer As IP_ADDR_STRING
   bHaveWins As Long
   PrimaryWinsServer As IP_ADDR_STRING
   SecondaryWinsServer As IP_ADDR_STRING
   LeaseObtained As Long
   LeaseExpires As Long
End Type

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
  (pTcpTable As Any, _
   pdwSize As Long) As Long
   
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (dst As Any, _
   src As Any, _
   ByVal bcount As Long)
   

Private Sub Command1_Click()

   Text1.Text = LocalIPAddress()

End Sub

   
Private Function LocalIPAddress() As String
   
  'api vars
   Dim cbRequired  As Long
   Dim buff()      As Byte
   Dim Adapter     As IP_ADAPTER_INFO
   Dim AdapterStr  As IP_ADDR_STRING
    
  'working vars
   Dim ptr1        As Long
   Dim sIPAddr     As String
   Dim found       As Boolean
   
   Call GetAdaptersInfo(ByVal 0&, cbRequired)

   If cbRequired > 0 Then
    
      ReDim buff(0 To cbRequired - 1) As Byte
      
      If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
      
        'get a pointer to the data stored in buff()
         ptr1 = VarPtr(buff(0))

         Do While (ptr1 <> 0) 'And (found = False)
         
           'copy the data from the pointer to the
           'first adapter into the IP_ADAPTER_INFO type
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
         
            With Adapter
                       
              'the DHCP IP address is in the
              'IpAddress.IpAddr member
                 
               sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
                  
               If Len(sIPAddr) > 0 Then
                  found = True
                  Exit Do
               End If

               ptr1 = .dwNext
                              
            End With  'With Adapter
            
        'ptr1 is 0 when (no more adapters)
         Loop  'Do While (ptr1 <> 0)

      End If  'If GetAdaptersInfo
   End If  'If cbRequired > 0

  'return any string found
   LocalIPAddress = sIPAddr
   
   
End Function


Private Function TrimNull(item As String)

    Dim pos As Integer
   
   'double check that there is a chr$(0) in the string
    pos = InStr(item, Chr$(0))
    If pos Then
       TrimNull = Left$(item, pos - 1)
    Else
       TrimNull = item
    End If
  
End Function

Comments

PayPal Link