Network Monitor
July 19, 2008
Option Explicit
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
Const WAIT_OBJECT_0 = 0
Const WAIT_TIMEOUT = &H102
Dim stopflag As Boolean
Dim errorflag As Boolean
Dim mindelay As Integer
Dim maxdelay As Integer
Dim totaldelay As Long
Dim avgdelay As Integer
Dim lcount As Long
Dim pingMessage(26) As String
Dim ctrl
Private Declare Function SendMessage Lib “User32″ Alias “SendMessageA” (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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 WaitForSingleObject Lib “kernel32″ (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib “kernel32″ (ByVal hObject As Long) As Long
Private Sub cmdClear_Click()
Open “C:\log.txt” For Output As #1
Close #1
txtoutput.Text = “”
txtpinglog.Text = “”
End Sub
Private Sub cmdExit_Click()
Unload Me
End
End Sub
Private Sub cmdlog_Click()
Load frmlog
frmlog.Show 1
End Sub
Private Sub cmdPing_Click()
DoEvents
If cmdPing.Caption = “Ping” Then
lblstatus.Caption = “Pinging ” & txtIP.Text & ” with ” & txtbuffer.Text & “KB of data”
txtIP.Locked = True
cmdPing.BackColor = &HFF&
cmdlog.Enabled = False
cmdPing.Caption = “Stop”
stopflag = False
Else
stopflag = True
cmdPing.Caption = “Ping”
txtIP.Locked = False
cmdPing.BackColor = &H80FF80
cmdlog.Enabled = True
lblstatus.Caption = “Stopped”
End If
While stopflag = False
DoEvents
Dim ShellX As String
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
Dim VarX As String
Dim Ptime As Integer
Dim pttl As Integer
Dim pbyte As Integer
Dim i As Integer
Dim pingresult As String
Dim tmin As Integer
Dim tmax As Integer
Dim tavg As Integer
If txtIP.Text <> “” Then
DoEvents
ShellX = Shell(”command.com /c ping -n 1 -l ” & txtbuffer.Text & ” ” & txtIP.Text & ” > C:\log.txt”, vbHide)
lPid = ShellX
If lPid <> 0 Then
lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
If lHnd <> 0 Then
lRet = WaitForSingleObject(lHnd, INFINITE)
CloseHandle (lHnd)
End If
frmmain.MousePointer = 0
Open “C:\log.txt” For Input As #1
txtoutput.Text = Input(LOF(1), 1)
pingresult = Trim(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “:”) + 1, Len(txtoutput.Text) - (InStr(1, txtoutput.Text, “:”) + Len(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “Ping “))))))
‘check for error
If InStr(1, pingresult, “Reply”) = 0 Then
Dim message As String
If InStr(1, pingresult, “Hardware”) <> 0 Then
message = “HARDWARE FAULT”
Else
If InStr(1, pingresult, “Request”) <> 0 Then
message = “Request time out”
Else
If InStr(1, pingresult, “Destination”) <> 0 Then
message = “Destination Computer is not reachable”
Else
message = pingresult
End If
End If
End If
pingresult = “ERROR with ” & txtIP.Text & “:” & message
‘pingmessage
txtpinglog.Text = “”
For i = 0 To 22
pingMessage(i) = pingMessage(i + 1)
If pingMessage(i + 1) <> “” Then
If txtpinglog.Text <> “” Then
txtpinglog.Text = txtpinglog.Text & vbCrLf
End If
txtpinglog.Text = txtpinglog.Text & pingMessage(i + 1)
End If
Next
pingMessage(23) = pingresult
If txtpinglog.Text <> “” Then
txtpinglog.Text = txtpinglog.Text & vbCrLf
End If
txtpinglog.Text = txtpinglog.Text & pingresult
For i = 0 To 31
pbrtime(i).Value = pbrtime(i + 1).Value
Next
pbrtime(32).Value = 0
‘loging
If chklog.Value = 1 Then
If errorflag = False Then
errorflag = True
Open “c:\pinglog.txt” For Append As #2
Print #2, Now
Print #2, pingresult
Print #2, String(91, “*”)
Close #2
End If
End If
lcount = 0
mindelay = 0
maxdelay = 0
avgdelay = 0
totaldelay = 0
lblmin = mindelay
lblmax = maxdelay
lblavg = avgdelay
Else
lcount = lcount + 1
Ptime = CInt(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “time”) + 5, InStr(1, txtoutput.Text, “ms “) - InStr(1, txtoutput.Text, “time”) - 5))
pbyte = CInt(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “bytes=”) + 6, InStr(1, txtoutput.Text, ” time”) - InStr(1, txtoutput.Text, “bytes=”) - 6))
pttl = CInt(Mid(pingresult, InStr(1, pingresult, “TTL=”) + 4, Len(pingresult) - InStr(1, pingresult, “TTL=”) - 5))
tmin = CInt(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “Minimum = “) + 10, InStr(InStr(1, txtoutput.Text, “Minimum = “), txtoutput.Text, “ms,”) - InStr(1, txtoutput.Text, “Minimum = “) - 10))
tmax = CInt(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “Maximum = “) + 10, InStr(InStr(1, txtoutput.Text, “Maximum = “), txtoutput.Text, “ms,”) - InStr(1, txtoutput.Text, “Maximum = “) - 10))
tavg = CInt(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “Average = “) + 10, InStr(InStr(1, txtoutput.Text, “Average = “), txtoutput.Text, “ms”) - InStr(1, txtoutput.Text, “Average = “) - 10))
If mindelay = 0 Then mindelay = tmin
If tmin < mindelay Then
mindelay = tmin
End If
If tmax > maxdelay Then
maxdelay = tmax
End If
totaldelay = totaldelay + tavg
avgdelay = CInt(totaldelay / lcount)
lblmin = mindelay
lblmax = maxdelay
lblavg = avgdelay
If avgdelay > 0 Then
For Each ctrl In frmmain
If TypeOf ctrl Is ProgressBar Then
ctrl.Max = avgdelay * 10
End If
Next
End If
pingresult = “Reply from ” & txtIP.Text & “: bytes=” & pbyte & ” time=” & Ptime & “ms TTL=” & pttl
txtpinglog.Text = “”
For i = 0 To 22
pingMessage(i) = pingMessage(i + 1)
If pingMessage(i + 1) <> “” Then
If txtpinglog.Text <> “” Then
txtpinglog.Text = txtpinglog.Text & vbCrLf
End If
txtpinglog.Text = txtpinglog.Text & pingMessage(i + 1)
End If
Next
pingMessage(23) = pingresult
If txtpinglog.Text <> “” Then
txtpinglog.Text = txtpinglog.Text & vbCrLf
End If
txtpinglog.Text = txtpinglog.Text & pingresult
‘loging
If chklog.Value = 1 Then
If errorflag = True Then
errorflag = False
Open “c:\pinglog.txt” For Append As #2
Print #2, Now
Print #2, “Reconnected with ” & txtIP.Text
Print #2, String(91, “*”)
Close #2
End If
End If
On Error Resume Next
Ptime = CInt(Mid(txtoutput.Text, InStr(1, txtoutput.Text, “time=”) + 5, InStr(1, txtoutput.Text, “ms “) - InStr(1, txtoutput.Text, “time=”) - 5))
For i = 0 To 31
pbrtime(i).Value = pbrtime(i + 1).Value
Next
pbrtime(32).Value = Ptime
End If
Close #1
End If
Else
frmmain.MousePointer = 0
VarX = MsgBox(”You have not entered an ip address or the number of times you want to ping.”, vbCritical, “Error has occured”)
End If
Wend
End Sub
Private Sub Command1_Click()
Load frmAbout
frmAbout.Show 1
End Sub
Private Sub Form_Load()
errorflag = False
totaldelay = 0
mindelay = 0
maxdelay = 0
avgdelay = 0
lcount = 0
Open “C:\log.txt” For Output As #1
Close #1
End Sub
Private Sub SelectText(ByRef textObj As RichTextBox)
textObj.SelStart = 0
textObj.SelLength = Len(textObj)
End Sub
Private Sub Label6_Click()
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Label2_Click()
End Sub
Private Sub Slider1_Change()
Select Case Slider1.Value
Case 0: txtbuffer.Text = 32
Case 1: txtbuffer.Text = 320
Case 2: txtbuffer.Text = 3200
Case 3: txtbuffer.Text = 32000
End Select
lcount = 0
mindelay = 0
maxdelay = 0
avgdelay = 0
totaldelay = 0
lblmin = mindelay
lblmax = maxdelay
lblavg = avgdelay
End Sub
Private Sub Timer1_Timer()
End Sub
Private Sub txtIP_GotFocus()
Call SelectText(txtIP)
End Sub
Private Sub txtOutput_GotFocus()
‘ Call SelectText(txtoutput)
End Sub
Private Sub txtStatus_Click()
txtIP.SetFocus
End Sub
Public Function IsGroupMember(Username As String, _
DomainName As String, _
GroupName As String) As Boolean
‘=================================================
‘=================================================
‘ Purpose: To determin if a user is a member of a specified group
‘
‘ Syntax: IsGroupMember(User Name, Domain Name, Group Name)
‘
‘ Arguments:
‘ username — login ID of user to verify
‘ DomainName — Domain name the user and group reside in
‘ (Can also use IP Address of Primary Domain Controller)
‘ GroupName — NT Group name to match the user to
‘
‘ Example: IsGroupMember(”myusername”, “mydomain”, “mygroupname”)
‘==========================================================
‘==========================================================
Dim usr As IADsUser, obj As Object, sOut() As String, i As Long
IsGroupMember = False
Set usr = GetObject(”WinNT://” & DomainName & “/” & Username & “,user”)
For Each obj In usr.Groups
If GroupName = obj.Name Then IsGroupMember = True
Next
End Function
Function IsGoodPWD(sUserName As String, DomainName As String, _
chkPassword As String) As Boolean
‘====================================================
‘=====================================================
‘ Purpose: To determin if a password given is the correct network password for the specified user
‘
‘ Syntax: IsGoodPWD(User Name, Domain Name, Password)
‘
‘ Arguments:
‘ username — login ID of user to verify
‘ DomainName — Domain name the user and group reside in
‘ (Can also use IP Address of Primary Domain Controller)
‘ chkPassword — Password to verify against the domain
‘
‘ Example: IsGoodPWD(”myusername”, “mydomain”, “mypass123″)
‘==============================================================
‘=========================================================
On Error GoTo MyError:
Dim usr As IADsUser
Set usr = GetObject(”WinNT://” & DomainName & “/” & sUserName & “,user”)
usr.ChangePassword chkPassword, “qinspwue4″
usr.ChangePassword “qinspwue4″, chkPassword
IsGoodPWD = True
Exit Function
MyError:
IsGoodPWD = False
End Function
Public Function ShowGroupMembers(DomainName As String, _
UserGroupName As String)
‘=========================================================
‘=========================================================
‘ Purpose: To display the members of a specified user group
‘
‘ Syntax: ShowGroupMembers(Domain Name, User Group Name)
‘
‘ Arguments:
‘ DomainName — Domain name the user and group reside in
‘ (Can also use IP Address of Primary Domain Controller)
‘ UserGroupName — The name of the NT User Group
‘
‘ Example: Call ShowGroupMembers(”mydomain”, “mygroupname”)
‘============================================================
‘============================================================
Dim grp As IADsGroup, User As Object
Set grp = GetObject(”WinNT://” & DomainName & “/” & UserGroupName & “”)
For Each User In grp.members
Debug.Print User.Name
Next User
End Function
