VERSION 5.00
Begin VB.Form frmIP
BorderStyle = 1 'Fixed Single
Caption = "ipconfig"
ClientHeight = 5385
ClientLeft = 45
ClientTop = 330
ClientWidth = 9075
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5385
ScaleWidth = 9075
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmd
Caption = "Refresh"
Default = -1 'True
Height = 375
Left = 4080
TabIndex = 1
Top = 5000
Width = 855
End
Begin VB.TextBox txt
BackColor = &H00000000&
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 4935
Left = 0
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 0
Width = 9015
End
End
Attribute VB_Name = "frmIP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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