Set the IP Address in VB6

[pcuser_tom]

I've been trying to find a way to set the IP Address in VB6 without WMI or shelling out to netsh and without the need to reboot but I can't figure out how to do it. Iphlpapi.dll has a function called SetAdapterIPAddress but I don't know how to declare it.

The "IPChange" sample included in the Platform SDK doesn't replace/change the IP Address, it only adds an additional IP via AddIPAddress.

I'm really stumped on this one. Does anyone know how this can be done in VB6?

Tom

[pcuser_tom]

I answered my own question but my journey to figure this out has led me to believe that nobody really knows how to do this and I'm posting the code so it'll be public knowledge from now on...

Make a new vb6 project with these controls:

Command1

Option1 (caption=static)

Option2 (caption=dhcp)

Label1 (caption=IP Address)

Label2 (caption=Netmask)

Label3 (caption=Gateway)

Label4 (caption=DNS Server)

Text1 (caption=IP Address)

Text2 (caption=Netmask)

Text3 (caption=Gateway)

Text4 (caption=DNS Server)

frmMain

' *****************************************************************************************
' This example uses a VERY undocumented function in iphlpapi.dll						  *
' called "SetAdapterIPAddress".  This function accepts 5 parameters					   *
' (1 string value and 4 DWORD values).  Since DWORD isn't a supported					 *
' data type in vb, we have to declare it as long with ByVal.							  *
'																						 *
' PARAMETER-1 is a String value for the network adapter GUID which can be found		   *
' in the registry at																	  *
' "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces"	  *
'																						 *
' PARAMETER-2 is a DWORD value that can be either 0 or 1 to indicate whether or not	   *
' DHCP is to be used																	  *
'																						 *
' PARAMETER-3 is a DWORD value for the IP Address (already converted to long).  IF		*
' DHCP won't be used then it should be set to vbNull									  *
'																						 *
' PARAMETER-4 is a DWORD value for the Netmask (already converted to long).  IF		   *
' DHCP won't be used then it should be set to vbNull									  *
'																						 *
' PARAMETER-5 is a DWORD value for the Gateway (already converted to long).  IF		   *
' DHCP won't be used then it should be set to vbNull									  *
'																						 *
' The only problem is that this function doesn't modify or set the DNS Server address	 *
' but the good news is that all we have to do is change the value in the registry at	  *
' "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\(guid)\NameServer"  *
' If you're using DHCP then this has to be changed before calling SetAdapterIPAddress	 *
' or the old DNS value won't be changed.												  *
'																						 *
' Change MyGUID in the Command1_Click event to match your network adapter				 *
'																						 *
'******************************************************************************************

Private Declare Function SetAdapterIPAddress Lib "Iphlpapi" Alias "#135" (ByVal szAdapterGUID As String, ByVal dwDHCP As Long, ByVal dwIP As Long, ByVal dwMask As Long, ByVal dwGateway As Long) As Long

' Structure to hold all four bytes of the IP address.
Private Type myBytes
B1 As Byte
B2 As Byte
B3 As Byte
B4 As Byte
End Type

' Structure to copy to/from using LSet.
Private Type myLong
Val As Long
End Type

' Convert a dotted quad IP string to a Long.
Private Function IP2Long(IP As String) As Long
' Perhaps the bytes are not in the politically correct order,
' but as long as you undo it with Long2IP you'll be fine.
ReDim parse(0 To 3) As String
Dim B As myBytes
Dim L As myLong
parse = Split(IP, ".")
B.B1 = Val(parse(0))
B.B2 = Val(parse(1))
B.B3 = Val(parse(2))
B.B4 = Val(parse(3))
LSet L = B
IP2Long = L.Val
End Function

Private Sub Command1_Click()
Dim MyGUID As String
Dim DoDHCP As Integer
Dim MyIP As String
Dim MyNetMask As String
Dim MyGateway As String
Dim MyDNS As String

MyGUID = "{6D89D9xx-DDCx-423x-86xx-1DDB3A057xxx}"

Screen.MousePointer = vbHourglass

' Static
If Option1.Value = True Then
	DoDHCP = 0
	MyIP = IP2Long(Text1.Text)
	MyNetMask = IP2Long(Text2.Text)
	MyGateway = IP2Long(Text3.Text)
	SetKeyValue "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & MyGUID, "NameServer", Text4.Text, REG_SZ
Else
' DHCP
	DoDHCP = 1
	MyIP = vbNull
	MyNetMask = vbNull
	MyGateway = vbNull
	SetKeyValue "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & MyGUID, "NameServer", "", REG_SZ
End If

DoIT = SetAdapterIPAddress(MyGUID, DoDHCP, MyIP, MyNetMask, MyGateway)

Screen.MousePointer = vbDefault

MsgBox "Done"

End Sub

Private Sub SetKeyValue(sKeyName As String, sValueName As String, _
vValueSetting As Variant, lValueType As Long)
	Dim lRetVal As Long		 'result of the SetValueEx function
	Dim hKey As Long		 'handle of open key

	'open the specified key
	lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, _
							  KEY_SET_VALUE, hKey)
	lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
	RegCloseKey (hKey)
End Sub

Private Sub Option1_Click()
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
End Sub

Private Sub Option2_Click()
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
End Sub

modRegistry

Option Explicit

   Public Const REG_SZ As Long = 1
   Public Const REG_DWORD As Long = 4

   Public Const HKEY_CLASSES_ROOT = &H80000000
   Public Const HKEY_CURRENT_USER = &H80000001
   Public Const HKEY_LOCAL_MACHINE = &H80000002
   Public Const HKEY_USERS = &H80000003

   Public Const ERROR_NONE = 0
   Public Const ERROR_BADDB = 1
   Public Const ERROR_BADKEY = 2
   Public Const ERROR_CANTOPEN = 3
   Public Const ERROR_CANTREAD = 4
   Public Const ERROR_CANTWRITE = 5
   Public Const ERROR_OUTOFMEMORY = 6
   Public Const ERROR_ARENA_TRASHED = 7
   Public Const ERROR_ACCESS_DENIED = 8
   Public Const ERROR_INVALID_PARAMETERS = 87
   Public Const ERROR_NO_MORE_ITEMS = 259

   Public Const KEY_QUERY_VALUE = &H1
   Public Const KEY_SET_VALUE = &H2
   Public Const KEY_ALL_ACCESS = &H3F

   Public Const REG_OPTION_NON_VOLATILE = 0

   Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
   Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
   "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
   As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
   As Long, phkResult As Long, lpdwDisposition As Long) As Long
   Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
   Long) As Long
   Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As String, lpcbData As Long) As Long
   Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, lpData As _
   Long, lpcbData As Long) As Long
   Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As Long, lpcbData As Long) As Long
   Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
   String, ByVal cbData As Long) As Long
   Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
   ByVal cbData As Long) As Long

   Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
   lType As Long, vValue As Variant) As Long
	   Dim lValue As Long
	   Dim sValue As String
	   Select Case lType
		   Case REG_SZ
			   sValue = vValue & Chr$(0)
			   SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
											  lType, sValue, Len(sValue))
		   Case REG_DWORD
			   lValue = vValue
			   SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
   lType, lValue, 4)
		   End Select
   End Function

   Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
   String, vValue As Variant) As Long
	   Dim cch As Long
	   Dim lrc As Long
	   Dim lType As Long
	   Dim lValue As Long
	   Dim sValue As String

	   On Error GoTo QueryValueExError

	   ' Determine the size and type of data to be read
	   lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
	   If lrc <> ERROR_NONE Then Error 5

	   Select Case lType
		   ' For strings
		   Case REG_SZ:
			   sValue = String(cch, 0)

   lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
   sValue, cch)
			   If lrc = ERROR_NONE Then
				   vValue = Left$(sValue, cch - 1)
			   Else
				   vValue = Empty
			   End If
		   ' For DWORDS
		   Case REG_DWORD:
   lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
   lValue, cch)
			   If lrc = ERROR_NONE Then vValue = lValue
		   Case Else
			   'all other data types not supported
			   lrc = -1
	   End Select

QueryValueExExit:
	   QueryValueEx = lrc
	   Exit Function

QueryValueExError:
	   Resume QueryValueExExit
   End Function

My main goal here was to be able to change from a static IP to dhcp (and back again) from a basic BartPE build where WMI doesn't work and you can't shell out to netsh/ipconfig and a reboot isn't an option.

Tom

Edited April 9, 2006 by pcuser_tom

[RogueSpear]

Excellent post I'm sure that I will need to reference this again not too far down the road.