2008-01-31

ipconfig

Description: Shows system network configuration information, using ipconfig/winipcfg
Minimum requirements: VB4
Download: source code
Screenshot:

Controls: cmd (CommandButton), txt (TextBox)
Code:
Option Explicit

Private Const OS_ERROR = -1
Private Const OS_95 = 1

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(LpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400

Private Sub cmd_Click()
Dim nOS As Long
Dim temp As String, bDNS As Boolean
Dim hProcess As Long
Dim ProcessId As Long
Dim exitCode As Long

Me.MousePointer = vbHourglass
nOS = GetOSVersion
If nOS = OS_ERROR Then
MsgBox "Unsupported operating system"
Exit Sub
End If
txt = ""

Open App.Path & "\ip.bat" For Output As 1
If nOS = OS_95 Then
Print #1, "Winipcfg.exe /all /batch " & App.Path & "\1.txt"
Print #1, "ren " & App.Path & "\1.txt ip.txt"
Else
Print #1, "ipconfig /all > " & App.Path & "\ip.txt"
End If
Close #1
While Dir(App.Path & "\ip.bat") = ""
DoEvents
Wend
ProcessId = Shell(App.Path & "\ip.bat", vbHide)
If nOS = OS_95 Then
While Dir(App.Path & "\ip.txt") = ""
DoEvents
Wend
Else
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId)
Do
Call GetExitCodeProcess(hProcess, exitCode)
DoEvents
Loop While exitCode > 0
End If
CloseHandle hProcess
Open App.Path & "\ip.txt" For Input As 1
While Not EOF(1)
Line Input #1, temp
If Trim(temp) <> "" Then txt = txt & Trim(temp) & vbCrLf
Wend
Close #1
Kill App.Path & "\ip.bat"
Kill App.Path & "\ip.txt"
Me.MousePointer = vbNormal
End Sub

Private Sub Form_Load()
cmd_Click
End Sub

Private Function GetOSVersion() As Long
Dim os As OSVERSIONINFO
Dim nRet As Long
os.dwOSVersionInfoSize = Len(os)
nRet = GetVersionEx(os)
If nRet = 0 Then
GetOSVersion = -1
ElseIf os.dwPlatformId = 0 Then '"Windows 32s "
GetOSVersion = -1 'not supported by this program
Else
GetOSVersion = os.dwPlatformId
End If
End Function

No comments: