• Home
 · 
• Internet/HTML
 · 
• Network Ping By VB

Network Ping By VB

Network Ping By VB

Rate Network Ping By VB

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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 chklog_Click()

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 = 1000
Case 1: txtbuffer.Text = 2000
Case 2: txtbuffer.Text = 3000
Case 3: txtbuffer.Text = 4000

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