Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'Example Name: How to Release and Renew DHCP IP Addresses'------------------------------------------------------------------------------ ' ' BAS Moduel Code 'Option ExplicitPublic 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 = 256Public Const ERROR_BUFFER_OVERFLOW As Long = 111 Public Const ERROR_INSUFFICIENT_BUFFER As Long = 122 Public Const GMEM_FIXED As Long = &H0Public Const LB_SETTABSTOPS As Long = &H192Public Const IP_SUCCESS As Long = 0 Public Const ERROR_SUCCESS As Long = 0Private Const MAX_WSADescription As Long = 256 Private Const MAX_WSASYSStatus As Long = 128 Private Const WS_VERSION_REQD As Long = &H101Private 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 TypePrivate Type IP_ADDRESS_STRING IpAddr(0 To 15) As Byte End TypePrivate Type IP_MASK_STRING IpMask(0 To 15) As Byte End TypePrivate Type IP_ADDR_STRING dwNext As Long IpAddress As IP_ADDRESS_STRING IpMask As IP_MASK_STRING dwContext As Long End TypePublic 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 TypePrivate Type IP_ADAPTER_INDEX_MAP Index As Long AdapterName(0 To MAX_ADAPTER_NAME - 1) As Integer End TypePrivate Type IP_INTERFACE_INFO NumAdapters As Long Adapter As IP_ADAPTER_INDEX_MAP End TypePublic 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 LongPrivate Declare Function IPReleaseAddress Lib "iphlpapi.dll" _ Alias "IpReleaseAddress" _ (AdapterInfo As IP_ADAPTER_INDEX_MAP) As LongPrivate Declare Function IPRenewAddress Lib "iphlpapi.dll" _ Alias "IpRenewAddress" _ (AdapterInfo As IP_ADAPTER_INDEX_MAP) As LongPrivate Declare Function GlobalAlloc Lib "kernel32" _ (ByVal wFlags As Long, _ ByVal dwBytes As Long) As LongPrivate Declare Function GlobalFree Lib "kernel32" _ (ByVal hMem As Long) As LongPublic 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 LongPublic Declare Function WSACleanup Lib "ws2_32.dll" () As LongPublic Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As LongPublic Function SocketsInitialize() As Boolean Dim WSAD As WSADATA
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 bufptrEnd 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 bufptrEnd Function '--end block--'
'------------------------------------------------------------------------------ ' ' Form Code ' '------------------------------------------------------------------------------ Option ExplicitPrivate 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 IfEnd 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 IfEnd Sub Private Sub List1_Click() Command1.Enabled = List1.ListIndex > -1 Command2.Enabled = List1.ListIndex > -1End 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 IfEnd SubPrivate 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
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'Example Name: How to Release and Renew DHCP IP Addresses'------------------------------------------------------------------------------
'
' BAS Moduel Code
'Option ExplicitPublic 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 = 256Public Const ERROR_BUFFER_OVERFLOW As Long = 111
Public Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Public Const GMEM_FIXED As Long = &H0Public Const LB_SETTABSTOPS As Long = &H192Public Const IP_SUCCESS As Long = 0
Public Const ERROR_SUCCESS As Long = 0Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101Private 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 TypePrivate Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End TypePrivate Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End TypePrivate Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End TypePublic 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 TypePrivate Type IP_ADAPTER_INDEX_MAP
Index As Long
AdapterName(0 To MAX_ADAPTER_NAME - 1) As Integer
End TypePrivate Type IP_INTERFACE_INFO
NumAdapters As Long
Adapter As IP_ADAPTER_INDEX_MAP
End TypePublic 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 LongPrivate Declare Function IPReleaseAddress Lib "iphlpapi.dll" _
Alias "IpReleaseAddress" _
(AdapterInfo As IP_ADAPTER_INDEX_MAP) As LongPrivate Declare Function IPRenewAddress Lib "iphlpapi.dll" _
Alias "IpRenewAddress" _
(AdapterInfo As IP_ADAPTER_INDEX_MAP) As LongPrivate Declare Function GlobalAlloc Lib "kernel32" _
(ByVal wFlags As Long, _
ByVal dwBytes As Long) As LongPrivate Declare Function GlobalFree Lib "kernel32" _
(ByVal hMem As Long) As LongPublic 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 LongPublic Declare Function WSACleanup Lib "ws2_32.dll" () As LongPublic Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As LongPublic 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 bufptrEnd 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 bufptrEnd Function
'--end block--'
'------------------------------------------------------------------------------
'
' Form Code
'
'------------------------------------------------------------------------------
Option ExplicitPrivate 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 IfEnd 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 IfEnd Sub
Private Sub List1_Click() Command1.Enabled = List1.ListIndex > -1
Command2.Enabled = List1.ListIndex > -1End 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 IfEnd SubPrivate 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