pcuser_tom Posted March 21, 2006 Posted March 21, 2006 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 Posted April 9, 2006 Author Posted April 9, 2006 (edited) 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:Command1Option1 (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 myBytesB1 As ByteB2 As ByteB3 As ByteB4 As ByteEnd Type' Structure to copy to/from using LSet.Private Type myLongVal As LongEnd 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 StringDim B As myBytesDim L As myLongparse = Split(IP, ".")B.B1 = Val(parse(0))B.B2 = Val(parse(1))B.B3 = Val(parse(2))B.B4 = Val(parse(3))LSet L = BIP2Long = L.ValEnd FunctionPrivate Sub Command1_Click()Dim MyGUID As StringDim DoDHCP As IntegerDim MyIP As StringDim MyNetMask As StringDim MyGateway As StringDim MyDNS As StringMyGUID = "{6D89D9xx-DDCx-423x-86xx-1DDB3A057xxx}"Screen.MousePointer = vbHourglass' StaticIf 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_SZElse' DHCP DoDHCP = 1 MyIP = vbNull MyNetMask = vbNull MyGateway = vbNull SetKeyValue "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & MyGUID, "NameServer", "", REG_SZEnd IfDoIT = SetAdapterIPAddress(MyGUID, DoDHCP, MyIP, MyNetMask, MyGateway)Screen.MousePointer = vbDefaultMsgBox "Done"End SubPrivate 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 SubPrivate Sub Option1_Click()Text1.Enabled = TrueText2.Enabled = TrueText3.Enabled = TrueText4.Enabled = TrueEnd SubPrivate Sub Option2_Click()Text1.Enabled = FalseText2.Enabled = FalseText3.Enabled = FalseText4.Enabled = FalseEnd SubmodRegistryOption 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 SelectQueryValueExExit: QueryValueEx = lrc Exit FunctionQueryValueExError: Resume QueryValueExExit End FunctionMy 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 Posted April 9, 2006 Posted April 9, 2006 Excellent post I'm sure that I will need to reference this again not too far down the road.
Recommended Posts
Please sign in to comment
You will be able to leave a comment after signing in
Sign In Now