How to ping System IP using VB?

[premMS143]

Hi,
I want to ping certain systems IP. Everytime I'm using DOS or Start --> Run mode for pinging different PCs. But its becoming very difficult.
So I planned to develop a VB application to make this job easier.
Aplication contains;
1. Option buttons named as PC names
2. A Command Button named as START & another STOP
Whenever a user selects the PC name & clicks on START button, pinging should be start & pinging status should be shown in Text box.


ANybody idea..? Please help me...

Thanx in Advans
Prem

[vacvac]

I'm not so sure about the code, but you can try it

Public Function ComputerIsOnline(ByVal strComputerName As String) As Boolean
    On Error GoTo ErrorHandler
 
    Dim strResult   As String
    Dim ShellX      As String
    Dim FileNum     As Integer
    Dim lPid        As Long
    Dim lHnd        As Long
    Dim lRet        As Long
 
    'DoEvents
    ShellX = Shell("command.com /c ping -n 2 " & strComputerName & " > 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
        FileNum = FreeFile
        Open "log.txt" For Input As #FileNum
        strResult = Input(LOF(1), 1)
        Close #FileNum
        ComputerIsOnline = (InStr(strResult, "Lost = 0") > 0)
    End If
    Exit Function
ErrorHandler:
    ComputerIsOnline = False
    Exit Function
End Function
 

[jg007]

it is for vb.net and hopefully I have not made any mistakes converting it but -

on the form I have a textbox for a PC ID or an IP address , a button to start it off and a richtextbox to show the result and a timer called Timer1

 
Imports System.Net.NetworkInformation
 
Public Class Form1
 
    Dim pingwsname As String = ""
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
    End Sub
 
 
    Private Function GetStatusString(ByVal status As IPStatus) As String
 
        'Convert IPstatus to a string that can be reported to the user
 
 
        Select Case status
 
            Case IPStatus.Success
                Return "Success."
            Case IPStatus.DestinationHostUnreachable
                Return "Destination host unreachable."
            Case IPStatus.DestinationNetworkUnreachable
                Return "Destination network unreachable."
            Case IPStatus.DestinationPortUnreachable
                Return "Destination port unreachable."
            Case IPStatus.DestinationProtocolUnreachable
                Return "Destination protocol unreachable."
            Case IPStatus.PacketTooBig
                Return "Packet too big."
            Case IPStatus.TtlExpired
                Return "TTL expired."
            Case IPStatus.ParameterProblem
                Return "Parameter problem."
            Case IPStatus.SourceQuench
                Return "Source quench."
            Case IPStatus.TimedOut
                Return "Request timed out."
        End Select
        Return "Ping failed."
    End Function
 
    Private Sub dothatfunkyping(ByVal WSname As String)
 
        pingwsname = WSname
        ' Set the window title
        Me.Text = "Ping results for " + WSname
        'Link the event handling procedure to the timer
 
        '000ms interval between pings
        Timer1.Interval = 1000
        Timer1.Start()
    End Sub
 
 
    Private Sub PingClientForm_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs)
 
        'Stop the timer to prevent errors caused by timer event firing after window closure
        Timer1.Stop()
 
    End Sub
 
 
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
 
        Try
 
            'Stop the timer before sending the ping, timer will be restarted after the reply is received,
            'stops it from attempting to send multiple pings at once
 
            Timer1.Stop()
 
            Dim pingSender = New Ping()
 
            'Send the packet with a 1500ms timeout
 
            Dim reply As PingReply = pingSender.Send(pingwsname, 1500)
 
            'Output the reply in the appropriate colour depending on RoundtripTime
 
            If reply.Status = IPStatus.Success Then
 
                If (reply.RoundtripTime <= 200) Then
 
                    RichTextBox1.SelectionColor = Color.Lime
 
                ElseIf (reply.RoundtripTime > 200 & reply.RoundtripTime <= 600) Then
 
                    RichTextBox1.SelectionColor = Color.Yellow
 
                Else
 
                    RichTextBox1.SelectionFont = New Font(Me.Font, FontStyle.Bold)
                    RichTextBox1.SelectionColor = Color.Red
 
                End If
 
                RichTextBox1.AppendText("Reply from " + reply.Address.ToString() + ": bytes= " + reply.Buffer.Length.ToString() + " Time= " + reply.RoundtripTime.ToString() + "ms TTL= " + reply.Options.Ttl.ToString() + vbCrLf)
                RichTextBox1.ScrollToCaret()
 
                'Adjusts the time to the next ping depending on RoundtripTime
                If (reply.RoundtripTime > 999) Then
 
                    Timer1.Interval = 1
 
                Else
 
                    Timer1.Interval = 1000 - reply.RoundtripTime
 
                End If
 
            Else
 
                ' Report status if not success
                RichTextBox1.SelectionFont = New Font(Me.Font, FontStyle.Bold)
                RichTextBox1.SelectionColor = Color.Red
                RichTextBox1.AppendText(GetStatusString(reply.Status) + vbCrLf)
                RichTextBox1.ScrollToCaret()
                Timer1.Start()
            End If
 
        Catch ex As ApplicationException
 
            'Catch cases of unknown host etc.
            RichTextBox1.SelectionFont = New Font(Me.Font, FontStyle.Bold)
            RichTextBox1.SelectionColor = Color.Red
            RichTextBox1.AppendText(ex.InnerException.Message + " " + pingwsname + vbCrLf)
            'No need for repeat pings so stop the timer
            Timer1.Stop()
        End Try
 
        'Restart the timer to schedule next ping
        Timer1.Start()
 
    End Sub
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        dothatfunkyping(TextBox1.Text)
    End Sub
End Class