'I needed to be able to change the IP address of my PC, for the duration of the applications lifetime. Obviously, this disrupts the users ability to access some network features, for example shared Internet Connections, so do not add it to any application, unless you are sure it is needed.
'Create the following global variables: Public DHCPEnabled As Boolean Public OriginalIPAddress As String Public OriginalSubNet As String Public IPChanged As Boolean
'In a module, declare the following functions: Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, ByVal dwprocessID As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, _ lbExitCode As Long) As Long
Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103
Public Function ShellAndWait(ByVal PathName As String, Optional WindowState) As Double
Dim hProg As Long Dim hProcess As Long, ExitCode As Long
If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is the process ID under Win32. To get the process handle - hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate the ExitCode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE ShellAndWait = 1
'The above functions process any shell commands, and wait for the response. In the shell commands we use, we send commands to the command prompt, and then create textfiles with the result. The shellanwait command simply allows us to pause until this file is created.
'In you main form load sub, place the following lines
Private Sub MDIForm_Load() Dim vbAns As Variant Dim fso As New FileSystemObject Dim ts As TextStream Dim myString As String
Dim shellmsg As Double
IPChanged = False Form4.Show ' Display your splash screen for a few seconds
shellmsg = ShellAndWait("cmd.exe /c NETSH INTERFACE IP SHOW CONFIG >c:\temp.txt", vbHide) ' Create textfile with the current network configuration setup. Set ts = fso.OpenTextFile("c:\temp.txt", ForReading)
myString = Replace(ts.ReadAll, " ", "")
If CBool(InStr(1, myString, "DHCPenabled:Yes")) = True Then DHCPEnabled = True ' Detect if DHCP Enabled for later Else DHCPEnabled = False 'Obtain IP and Gateways OriginalIPAddress = Mid(myString, InStr(1, myString, "IPAddress:") + 10, _ InStr(InStr(1, myString, "IPAddress:") + 10, myString, vbCrLf) - (InStr(1, myString, "IPAddress:") + 10)) OriginalSubNet = Mid(myString, InStr(1, myString, "SubnetMask:") + 11, _ InStr(InStr(1, myString, "SubnetMask:") + 11, myString, vbCrLf) - (InStr(1, myString, "SubnetMask:") + 11)) End If ts.Close 'Close temp text file and delete fso.DeleteFile "c:\temp.txt" Set ts = Nothing Set fso = Nothing
'If the class A network is already set to 10 or required, then skip changes. If DHCPEnabled = False Then If (Mid(OriginalIPAddress, 1, InStr(1, OriginalIPAddress, ".") - 1) = "10") Then 'already set to correct class A network GoTo RestOfForm End If End If
'Warn user what is about to occur! vbAns = MsgBox(" This PC is not set to the correct Class A Network." & vbCrLf & _ " Do you wish this application to change your Class A Network?" & vbCrLf & _ "(On exiting your network settings will be returned to default)", _ vbCritical + vbYesNo + vbDefaultButton1) If vbAns = vbYes Then 'If user choses to change IP, then set IP to new address IPChanged = True Screen.MousePointer = vbHourglass shellmsg = ShellAndWait("cmd.exe /c IPCONFIG /release >c:\temp2.txt", vbHide) shellmsg = ShellAndWait("cmd.exe /c NETSH INTERFACE IP SET ADDRESS " & _ Chr(34) & "Local Area Connection" & Chr(34) & _ " static 10.7.80.1 255.0.0.0 none", vbHide) Screen.MousePointer = vbDefault End If
'Hide splash screen Form4.Hide Unload Form4 'Place rest of form load procedure here.
Private Sub MDIForm_Unload(Cancel As Integer) Dim shellmsg As Double
'When leaving application, check to see if we changed the IP on loading If IPChanged = True Then 'if the ip address was changed at start, change it back Screen.MousePointer = vbHourglass 'If DHCP wasn't enabled, set the IP back to original If DHCPEnabled = False Then 'if the ip was NOT set using DHCP then - shellmsg = ShellAndWait("cmd.exe /c ipconfig /release > temp2.txt", vbHide) shellmsg = ShellAndWait("cmd.exe /c NETSH INTERFACE IP SET ADDRESS " & _ Chr(34) & "Local Area Connection" & Chr(34) & " static " & OriginalIPAddress & " " & _ OriginalSubNet & " None", vbHide)
'If DHCP was enabled, reset the DHCP ElseIf DHCPEnabled = True Then 'otherwise reset the DHCP network shellmsg = ShellAndWait("cmd.exe /c NETSH INTERFACE IP SET ADDRESS " & _ Chr(34) & "Local Area Connection" & Chr(34) & " dhcp", vbHide) End If Screen.MousePointer = vbDefault End If