Visual Basic Network Services
GetAdaptersInfo: Get the DHCP Server IP
     
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
None.

The IP_ADAPTER_INFO type returned from GetAdaptersInfo contains a DhcpServer member, which is a 16-byte string representing the IP address of the DHCP server.

This demo wraps a call to GetAdaptersInfo in the function DhcpServerAddress, which enumerates the installed NICs. If one has the uDhcpEnabled flag set, a pointer to the IP_ADAPTER_INFO's DhcpServer member is retrieved, whose data is coerced into an IP_ADDR_STRING structure using CopyMemory, resulting in the IP address of the server. Once a server has been found, the function exits.

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.

 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      As 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 = DhcpServerAddress()

End Sub

   
Private Function DhcpServerAddress() 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 ptr2        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
         
               If .uDhcpEnabled Then
  
                 'the DHCP info is in the DhcpServer
                 'member of IP_ADAPTER_INFO. This is
                 'in the IP_ADDR_STRING format, so
                 'it needs to be copied to the
                 'IP_ADDR_STRING type
                  ptr2 = VarPtr(.DhcpServer)
               
                 'again, the IP_ADDR_STRING type has a
                 'dwNext member, indicating that more
                 'than one DHCP server may be listed,
                 'so another loop is needed
                  Do While (ptr2 <> 0)
               
                     CopyMemory AdapterStr, ByVal ptr2, LenB(AdapterStr)
                  
                     With AdapterStr
                  
                       'the IP address of the DHCP
                       'server for this adapter.
                        sIPAddr = TrimNull(StrConv(.IpAddress.IpAddr, vbUnicode))
                     
                       'if something returned, exit the loop
                       'by setting a flag
                        If Len(sIPAddr) > 0 Then
                           found = True
                           Exit Do
                        End If
                  
                       'check for another server
                        ptr2 = .dwNext
                  
                     End With  'With AdapterStr
                  Loop  'Do While (ptr2 <> 0)
            
               End If  'If .uDhcpEnabled
               
              'check for another adapter
               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
   DhcpServerAddress = 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
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter