Jump to content
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble

MSFN is made available via donations, subscriptions and advertising revenue. The use of ad-blocking software hurts the site. Please disable ad-blocking software or set an exception for MSFN. Alternatively, register and become a site sponsor/subscriber and ads will be disabled automatically. 


Sign in to follow this  
pcuser_tom

Set the IP Address in VB6

Recommended Posts

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

Share this post


Link to post
Share on other sites

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 by pcuser_tom

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...