Syncronous Ping Module - Can this be changed to Syncronous 1

[Shift838]

I have the below coded module which performs an asyncronous ping, so it does not go to the next server in my datagridview until the curent server responds. I would like to be able to issue all the servers pinging at the same time. Can this code be changed to do that?

Imports System.Net.NetworkInformation
Imports System.Text
Module MultiPing
    Sub MultiPingSystem(ByVal HostName As String)
        'Ping the system and display results to the txtPingResult control

        'Clear any previous ping results
        pingresults = ""

        Dim pingsender As New Ping
        Dim options As New PingOptions

        'Modify the default fragmentation behavior
        options.DontFragment = True

        'Create a buffer of 32 bytes of data to be transmitted.      
        Dim data As String = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
        Dim buffer As Byte() = Encoding.ASCII.GetBytes(data)
        Dim timeout As Integer = 120

        Try
            'Attempt ping
            Dim reply As PingReply = pingsender.Send(HostName, timeout, buffer, options)
            
            If (reply.Status = IPStatus.Success) Then
                pingresults = "Success"

                lasttimeout = ""
                roundtriptime = GetMs(reply.RoundtripTime)

            Else
                pingresults = "Ping Failed"
            End If

            'Pause for 1 second before pinging again
            System.Threading.Thread.Sleep(1000)
            'Next
        Catch ex As Exception
            pingresults = "Ping Failed"
        End Try
    End Sub
    Function GetMs(ByVal ResponseTime As Integer) As String
        'accept and integer value and return a friendly string
        '  reflecting number of milliseconds
        If ResponseTime = 0 Then
            Return "<1ms"
        Else
            Return String.Format("={0}ms", ResponseTime.ToString)
        End If
    End Function
End Module

 

[Shift838]

The below code is how I execute the module from a click event:

Private Sub cmdStartPing_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdStartPing.Click
        Dim rc, myic As Integer
        Dim sname As String
        rc = DGV1.RowCount - 1

        bCancel = False
        Do Until bCancel = True

            For myic = 0 To rc

                Application.DoEvents()

                If bCancel Then
                    bCancel = True
                    DGV1.BackgroundColor = Color.White
                    MsgBox("Pinging Stopped")
                    Exit For
                End If

                sname = DGV1.Item(0, myic).Value
                MultiPingSystem(sname)
                If pingresults = "Success" Then
                    DGV1.Rows(myic).Cells(1).Value = "Success"
                    DGV1.Rows(myic).Cells(2).Value = roundtriptime
                    DGV1.Rows(myic).DefaultCellStyle.BackColor = Color.YellowGreen
                    DGV1.Refresh()
                Else
                    DGV1.Rows(myic).Cells(1).Value = "No Reply"
                    DGV1.Rows(myic).Cells(2).Value = "Timed Out"
                    DGV1.Rows(myic).Cells(3).Value = currentdt
                    DGV1.Rows(myic).DefaultCellStyle.BackColor = Color.Red
                    DGV1.Refresh()
                End If
            Next
        Loop
    End Sub

 

[Shift838]

i was able to get an asyncronous ping like I wanted for multiple servers with the below code. I am having a couple of issues i do not like that when pinging multiple hosts.

1. when a host is offline it take about 10 seconds to return the exception and log it on the datagridview
2. when #1 happens when I right click it takes about 10-20 seconds to pop up.

Imports System.Net.NetworkInformation
Module AsyncPingHost
    'Function PingIPAdress(ByVal IPAdress As String)
    Function PingHost(ByVal host As String)
        Dim ping As Ping
        Dim preply As PingReply
        ping = New Ping
        'Dim RetColor As Color
        'Try
        preply = ping.Send(host)
        roundtriptime = preply.RoundtripTime
        If preply.Status = IPStatus.Success Then
            pingresults = "Success"
        Else
            pingresults = "Failed"
        End If
        'Catch ex As Exception
        'pingresults = "Ping Failed"
        'End Try
        'Return RetColor
    End Function


End Module

I call it with:

Private Sub cmdStartPing_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdStartPing.Click

        Dim rc, myic As Integer
        Dim sname As String
        'Dim preply As PingReply

        pinging = 1
        cmdStopPing.Select()
        rc = DGV1.RowCount - 1

        If rc > -1 Then

            bCancel = False

            Do Until bCancel = True

                For myic = 0 To rc

                    Application.DoEvents()

                    If bCancel Then
                        bCancel = True
                        DGV1.BackgroundColor = Color.White
                        MsgBox("Pinging Stopped")
                        Exit For

                    End If
                    Try
                        sname = DGV1.Item(0, myic).Value

                        PingHost(sname)

                        If pingresults = "Success" Then
                            DGV1.Rows(myic).Cells(1).Value = "Success"
                            DGV1.Rows(myic).Cells(2).Value = roundtriptime
                            DGV1.Rows(myic).DefaultCellStyle.BackColor = Color.YellowGreen
                            DGV1.Refresh()
                        Else
                            DGV1.Rows(myic).Cells(1).Value = "No Reply"
                            DGV1.Rows(myic).Cells(2).Value = "Timed Out"
                            DGV1.Rows(myic).Cells(3).Value = currentdt
                            DGV1.Rows(myic).DefaultCellStyle.BackColor = Color.Red
                            DGV1.Refresh()
                        End If
                    Catch ex As Exception
                        DGV1.Rows(myic).Cells(1).Value = "No Reply"
                        DGV1.Rows(myic).Cells(2).Value = "Timed Out"
                        DGV1.Rows(myic).Cells(3).Value = currentdt
                        DGV1.Rows(myic).DefaultCellStyle.BackColor = Color.Red
                        DGV1.Refresh()
                    End Try
                Next

            Loop



        
        Else
            MsgBox("Please add at least one host to the datagrid to ping.")
        End If

    End Sub