[VBnet Network] IPRenewAddress: Release and Renew a DHCP IP Address

	Visual Basic Network Services IPRenewAddress: Release and Renew a DHCP IP Address

Posted:	Sunday May 27, 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, msnews, Wei Hua

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

Prerequisites

One of the operating systems listed under OS Restrictions above, plus IP assigned by a DHCP server.

This demo shows how to retrieve adapter info and, by specifying the adapter index returned from a call to GetAdaptersInfo, selectively release and renew the DHCP IP address for the adapter specified.

BAS Module Code

Place the following code into the general declarations area of a bas module:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Public Const MAX_ADAPTER_NAME As Long = 128
Public Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Public Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Public Const MAX_HOSTNAME_LEN As Long = 128
Public Const MAX_DOMAIN_NAME_LEN As Long = 128
Public Const MAX_SCOPE_ID_LEN As Long = 256

Public Const ERROR_BUFFER_OVERFLOW As Long = 111
Public Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Public Const GMEM_FIXED As Long = &H0

Public Const LB_SETTABSTOPS As Long = &H192

Public Const IP_SUCCESS As Long = 0
Public Const ERROR_SUCCESS As Long = 0

Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101

Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To MAX_WSADescription) As Byte
   szSystemStatus(0 To MAX_WSASYSStatus) As Byte
   wMaxSockets As Integer
   wMaxUDPDG As Integer
   dwVendorInfo As Long
End Type

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

Public 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 Type IP_ADAPTER_INDEX_MAP
   Index As Long
   AdapterName(0 To MAX_ADAPTER_NAME - 1) As Integer
End Type

Private Type IP_INTERFACE_INFO
   NumAdapters As Long
   Adapter As IP_ADAPTER_INDEX_MAP
End Type

Public Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
   (IpAdapterInfo As Any, _
   pOutBufLen As Long) As Long
   
Private Declare Function GetInterfaceInfo Lib "iphlpapi.dll" _
  (ByVal pIfTable As Long, _
   dwOutBufLen As Long) As Long

Private Declare Function IPReleaseAddress Lib "iphlpapi.dll" _
   Alias "IpReleaseAddress" _
  (AdapterInfo As IP_ADAPTER_INDEX_MAP) As Long

Private Declare Function IPRenewAddress Lib "iphlpapi.dll" _
   Alias "IpRenewAddress" _
  (AdapterInfo As IP_ADAPTER_INDEX_MAP) As Long

Private Declare Function GlobalAlloc Lib "kernel32" _
  (ByVal wFlags As Long, _
   ByVal dwBytes As Long) As Long

Private Declare Function GlobalFree Lib "kernel32" _
  (ByVal hMem As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)

Public Declare Function WSAStartup Lib "ws2_32.dll" _
  (ByVal wVR As Long, _
   lpWSAD As WSADATA) As Long

Public Declare Function WSACleanup Lib "ws2_32.dll" () As Long

Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long



Public Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA
   
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
    
End Function


Public Sub SocketsCleanup()
   
   If WSACleanup() <> 0 Then
       MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
   End If
    
End Sub


Public Function IPRelease(ByVal dwAdapterIndex As Long) As Boolean

  'api vars
   Dim bufptr        As Long
   Dim dwOutBufLen   As Long
   Dim ip_map        As IP_ADAPTER_INDEX_MAP
   
  'working vars
   Dim success       As Long
   Dim nStructSize   As Long
   Dim NumAdapters   As Long
   Dim cnt           As Long

  'call GetInterfaceInfo with a buffer
  'of 0 length to have the API return
  'the size needed
   success = GetInterfaceInfo(0, dwOutBufLen)

   If success <> 0 And _
      success = ERROR_INSUFFICIENT_BUFFER Then
   
     'allocate memory for the buffer
     'and call GetInterfaceInfo again,
     'passing the memory buffer
      bufptr = GlobalAlloc(GMEM_FIXED, dwOutBufLen)
      success = GetInterfaceInfo(bufptr, dwOutBufLen)
       
      If success = ERROR_SUCCESS Then
               
        'the first 4 bytes of the returned data
        'is a long holding the number of adapters
        'retrieved
         CopyMemory NumAdapters, ByVal bufptr, 4
         
        'set a variable to hold the size
        'of the ip_map struct
         nStructSize = LenB(ip_map)
         
        'if an adapter installed...
         If NumAdapters > 0 Then
         
           'loop through installed adapters...
            For cnt = 0 To NumAdapters - 1
               
              'Copy a block of data from the
              'buffer into the ip_map structure.
              'On subsequent calls, the buffer
              'data returned is offset by the
              'number of adapters read * the size
              'of 1 ip_map structure, plus 4 to
              'account for the numAdapters long
              'retrieved above.
               CopyMemory ip_map, _
                          ByVal bufptr + (nStructSize * cnt) + 4, _
                          nStructSize
               
              'compare the index to the value passed
               If ip_map.Index = dwAdapterIndex Then
                  
                 'release the IP and set the return
                 'value from this function to True if
                 'the API returned ERROR_SUCCESS (0)
                  IPRelease = IPReleaseAddress(ip_map) = ERROR_SUCCESS
                  
                  If success <> ERROR_SUCCESS Then
                      MsgBox "ReleaseIP error " & success & _
                             ", Err# is " & Err.LastDllError
                  End If
                  
               End If  'If ip_map.Index
            
            Next  'For cnt
         
         End If  'If NumAdapters
      End If  'If success = ERROR_SUCCESS
   End If  'If success <> 0
   
   GlobalFree bufptr

End Function


Public Function IPRenew(ByVal dwAdapterIndex As Long) As Boolean

  'api vars
   Dim bufptr        As Long
   Dim dwOutBufLen   As Long
   Dim ip_map        As IP_ADAPTER_INDEX_MAP
   
  'working vars
   Dim success       As Long
   Dim nStructSize   As Long
   Dim NumAdapters   As Long
   Dim cnt           As Long

  'call GetInterfaceInfo with a buffer
  'of 0 length to have the API return
  'the size needed
   success = GetInterfaceInfo(0, dwOutBufLen)

   If success <> 0 And _
      success = ERROR_INSUFFICIENT_BUFFER Then
   
     'allocate memory for the buffer
     'and call GetInterfaceInfo again,
     'passing the memory buffer
      bufptr = GlobalAlloc(GMEM_FIXED, dwOutBufLen)
      success = GetInterfaceInfo(bufptr, dwOutBufLen)
       
      If success = ERROR_SUCCESS Then
               
        'the first 4 bytes of the returned data
        'is a long holding the number of adapters
        'retrieved
         CopyMemory NumAdapters, ByVal bufptr, 4
         
        'set a variable to hold the size
        'of the ip_map struct
         nStructSize = LenB(ip_map)
         
        'if an adapter installed...
         If NumAdapters > 0 Then
         
           'loop through the adapters...
            For cnt = 0 To NumAdapters - 1
               
              'Copy a block of data from the
              'buffer into the ip_map structure.
              'On subsequent calls, the buffer
              'data returned is offset by the
              'number of adapters read * the size
              'of 1 ip_map structure, plus 4 to
              'account for the numAdapters long
              'retrieved above.
               CopyMemory ip_map, _
                          ByVal bufptr + (nStructSize * cnt) + 4, _
                          nStructSize
               
              'compare the index to the value passed
               If ip_map.Index = dwAdapterIndex Then
                  
                 'renew the IP and set the return
                 'value from this function to True if
                 'the API returned ERROR_SUCCESS (0)
                  IPRenew = IPRenewAddress(ip_map) = ERROR_SUCCESS
                  
                  If success <> ERROR_SUCCESS Then
                      MsgBox "IpRenewAddress error " & success & _
                             ", Err# is " & Err.LastDllError
                  End If
                  
               End If  'If ip_map.Index
            
            Next  'For cnt
         
         End If  'If NumAdapters
      End If  'If success = ERROR_SUCCESS
   End If  'If success <> 0
   
   GlobalFree bufptr

End Function

Form Code

To a form add a command button (Command1), and two list boxes to the form (List1 / List2). Add the following to the form:

Option Explicit

Private Sub Form_Load()

   ReDim TabArray(0 To 0) As Long
   TabArray(0) = 61
   
  'clear existing tabs and
  'set the list tabstops
   Call SendMessage(List2.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List2.hwnd, LB_SETTABSTOPS, 1&, TabArray(0))
   List2.Refresh
  
  'initialize winsock and load adapter data 
   SocketsInitialize
   DisplayAdatersInfo
 
   With Command1
      .Enabled = List1.ListIndex > -1
      .Caption = "Release IP"
   End With
   
   With Command2
      .Enabled = List1.ListIndex > -1
      .Caption = "Renew IP"
   End With
    
End Sub


Private Sub Form_Unload(Cancel As Integer)
    
    SocketsCleanup
    
End Sub


Private Sub Command1_Click()
   
   Dim ip_index As Long
   
   ip_index = CLng(List1.List(List1.ListIndex))
   
  'assure an adapter index has been selected
   If ip_index <> 0 Then
   
      Screen.MousePointer = vbHourglass
      
     'release the IP for the selected adapter
      If IPRelease(ip_index) Then
      
        'settings have changed, so
        'update the display
         DisplayAdatersInfo
         
      End If
      
      Screen.MousePointer = vbDefault
      
   End If

End Sub


Private Sub Command2_Click()

   Dim ip_index As Long
   
   ip_index = CLng(List1.List(List1.ListIndex))
   
  'assure an adapter index has been selected
   If ip_index <> 0 Then
   
      Screen.MousePointer = vbHourglass
      
     'release the IP for the selected adapter
      If IPRenew(ip_index) Then
      
        'settings have changed, so
        'update the display
         DisplayAdatersInfo
         
      End If
      
      Screen.MousePointer = vbDefault
      
   End If

End Sub


Private Sub List1_Click()

   Command1.Enabled = List1.ListIndex > -1
   Command2.Enabled = List1.ListIndex > -1

End Sub


Private Sub List1_MouseDown(Button As Integer, Shift As Integer, _
                            X As Single, Y As Single)

  'this just synchronizes selection in the 
  'lists, for display purposes only
   List2.ListIndex = List1.ListIndex
   
End Sub


Private Sub List2_MouseDown(Button As Integer, Shift As Integer, _
                            X As Single, Y As Single)

  'this just synchronizes selection in the 
  'lists, for display purposes only
   List1.ListIndex = List2.ListIndex
   
End Sub


Sub DisplayAdatersInfo()

  'populates two listboxes with adapter info

  'working vars
   Dim buff()      As Byte
   Dim cbRequired  As Long
   Dim Adapter     As IP_ADAPTER_INFO
   Dim ptr1        As Long
   
  'clear the lists
   List1.Clear
   List2.Clear
      
  'call GetAdaptersInfo with null as the
  'buffer to have the API return the needed
  'buffer size in cbRequired.
   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
   
         ptr1 = VarPtr(buff(0))
         
        'ptr1 is 0 when no more adapters
         Do While (ptr1 <> 0)
         
           'copy the pointer to the first adapter
           'into the IP_ADAPTER_INFO type
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
         
            With Adapter
         
              'The only thing we need to use
              'release/renew is the Adapter.dwIndex
              'value, added to list1. Data in List2
              'is purely for show, and is not
              'required to release or renew.
               List1.AddItem .dwIndex
               List2.AddItem TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode)) _
                             & vbTab & _
                             TrimNull(StrConv(.sDescription, vbUnicode))
               
               ptr1 = .dwNext
               
            End With  'With Adapter
            
         Loop  'Do While (ptr1 <> 0)
         
      End If
   End If

End Sub

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