Author: Admin 03/28/2021
Language:
Visual Basic .NET
Tags:
Pings a network/remote device.
Pings a network/remote device using an IP address or domain name.
Imports System.Net
Imports System.Net.NetworkInformation
Imports System.Text
Public Module Ping_Host
Public ReplyAddress As String
Public ReplyRoundtripTime As String
Public ReplyTTL As String
Public ReplyBuffer As String
Public PingError As String
''' Pings a network/remote device
Public Function PingHost(ByRef Host_Name As String, ByRef Time_Out As Integer, Optional ByRef TTL As Integer = 128, Optional ByRef Fragment As Boolean = False, Optional ByVal bufferSize As String = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb") As String
Try
Register.timer1.Start() 'See if the key code is there
Dim pingSender As New Ping()
Dim options As New PingOptions()
Dim PingReply As String = ""
PingError = ""
' Use the default Ttl value which is 128,
options.Ttl = TTL
' but change the fragmentation behavior.
options.DontFragment = Fragment
' Create a buffer of 32 bytes of data to be transmitted.
Dim data As String = bufferSize
Dim buffer() As Byte = Encoding.ASCII.GetBytes(data)
Dim timeout As Integer = Time_Out
Dim reply As PingReply = pingSender.Send(Host_Name, timeout, buffer, options)
If reply.Status = IPStatus.Success Then
PingReply = "(Address: " & reply.Address.ToString() & ")" & " (RoundTrip time: " & reply.RoundtripTime & ")" & " (Time to live: " & reply.Options.Ttl & ")" & " (Buffer size: " & reply.Buffer.Length & ")"
ReplyAddress = reply.Address.ToString : ReplyRoundtripTime = CStr(reply.RoundtripTime) : ReplyTTL = CStr(reply.Options.Ttl) : ReplyBuffer = CStr(reply.Buffer.Length)
ElseIf reply.Status = IPStatus.TimedOut Then
PingReply = "(Address: " & Host_Name & ")" & " TimedOut"
PingError = PingReply
ElseIf reply.Status = IPStatus.BadDestination Then
PingReply = "(Address: " & Host_Name & ")" & " Bad Destination"
PingError = PingReply
ElseIf reply.Status = IPStatus.BadRoute Then
PingReply = "(Address: " & Host_Name & ")" & " Bad Route"
PingError = PingReply
ElseIf reply.Status = IPStatus.DestinationHostUnreachable Then
PingReply = "(Address: " & Host_Name & ")" & " Destination Host Unreachable"
PingError = PingReply
ElseIf reply.Status = IPStatus.DestinationNetworkUnreachable Then
PingReply = "(Address: " & Host_Name & ")" & " Destination Network Unreachable"
PingError = PingReply
ElseIf reply.Status = IPStatus.DestinationPortUnreachable Then
PingReply = "(Address: " & Host_Name & ")" & " Destination Port Unreachable"
PingError = PingReply
ElseIf reply.Status = IPStatus.DestinationProhibited Then
PingReply = "(Address: " & Host_Name & ")" & " Destination Prohibited"
PingError = PingReply
ElseIf reply.Status = IPStatus.DestinationProtocolUnreachable Then
PingReply = "(Address: " & Host_Name & ")" & " Destination Protocol Unreachable"
PingError = PingReply
ElseIf reply.Status = IPStatus.DestinationScopeMismatch Then
PingReply = "(Address: " & Host_Name & ")" & " Destination Scope Mismatch"
PingError = PingReply
ElseIf reply.Status = IPStatus.DestinationUnreachable Then
PingReply = "(Address: " & Host_Name & ")" & " Destination Unreachable"
PingError = PingReply
ElseIf reply.Status = IPStatus.HardwareError Then
PingReply = "(Address: " & Host_Name & ")" & " Hardware Error"
PingError = PingReply
ElseIf reply.Status = IPStatus.IcmpError Then
PingReply = "(Address: " & Host_Name & ")" & " Icmp Error"
PingError = PingReply
ElseIf reply.Status = IPStatus.NoResources Then
PingReply = "(Address: " & Host_Name & ")" & " No Resources"
PingError = PingReply
ElseIf reply.Status = IPStatus.PacketTooBig Then
PingReply = "(Address: " & Host_Name & ")" & " Packet Too Big"
PingError = PingReply
ElseIf reply.Status = IPStatus.ParameterProblem Then
PingReply = "(Address: " & Host_Name & ")" & " Parameter Problem"
PingError = PingReply
ElseIf reply.Status = IPStatus.SourceQuench Then
PingReply = "(Address: " & Host_Name & ")" & " Source Quench"
PingError = PingReply
ElseIf reply.Status = IPStatus.TimeExceeded Then
PingReply = "(Address: " & Host_Name & ")" & " Time Exceeded"
PingError = PingReply
ElseIf reply.Status = IPStatus.TtlExpired Then
PingReply = "(Address: " & Host_Name & ")" & " Ttl Expired"
PingError = PingReply
ElseIf reply.Status = IPStatus.TtlReassemblyTimeExceeded Then
PingReply = "(Address: " & Host_Name & ")" & " Ttl Reassembly Time Exceeded"
PingError = PingReply
ElseIf reply.Status = IPStatus.Unknown Then
PingReply = "(Address: " & Host_Name & ")" & " Unknown"
PingError = PingReply
ElseIf reply.Status = IPStatus.UnrecognizedNextHeader Then
PingReply = "(Address: " & Host_Name & ")" & " Unrecognized Next Header"
PingError = PingReply
Else
PingReply = "(Address: " & Host_Name & ")" & " Error"
PingError = PingReply
End If
Return PingReply
Catch err As Exception
MsgBox(err.Message, MsgBoxStyle.Critical)
Return CStr(0)
End Try
End Function
End Module