Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing ctrlTraceRoute.vb (8.21 KB)
Option Explicit On
Imports System.ComponentModel
Imports System.Net
Imports System.Net.NetworkInformation
Public Class ctrlTraceRoute
Inherits Component
Public Class TracertNode
''' <summary>
''' Constructs a new object from the IPAddress of the node and the round trip time taken
''' </summary>
''' <param name="address"></param>
''' <param name="roundTripTime"></param>
Friend Sub New(ByVal address As IPAddress, ByVal roundTripTime As Long, ByVal status As IPStatus)
Me._address = address
Me._roundTripTime = roundTripTime
Me._status = status
End Sub
Private _address As IPAddress
''' <summary>
''' The IPAddress of the node
''' </summary>
Public ReadOnly Property Address() As IPAddress
Get
Return _address
End Get
End Property
Private _roundTripTime As Long
''' <summary>
''' The time taken to go to the node and come back to the originating node in milliseconds.
''' </summary>
Public ReadOnly Property RoundTripTime() As Long
Get
Return _roundTripTime
End Get
End Property
Private _status As IPStatus
''' <summary>
''' The IPStatus of request send to the node
''' </summary>
Public ReadOnly Property Status() As IPStatus
Get
Return _status
End Get
End Property
End Class
Public Class RouteNodeFoundEventArgs
Inherits EventArgs
Protected Friend Sub New(ByVal node As TracertNode, ByVal isDone As Boolean)
Me._node = node
Me._isLastNode = isDone
End Sub
Private _isLastNode As Boolean
''' <summary>
''' Indicates whether the value of the Node propert is the last node
''' found by Tracert
''' </summary>
Public ReadOnly Property IsLastNode() As Boolean
Get
Return _isLastNode
End Get
End Property
Private _node As TracertNode
''' <summary>
''' A node encountered during the route tracing.
''' </summary>
Public ReadOnly Property Node() As TracertNode
Get
Return _node
End Get
End Property
End Class
Private _ping As Ping
Private _nodes As List(Of TracertNode)
Private _isDone As Boolean
Private _destination As IPAddress
Private _options As PingOptions
''' <summary>
''' Fires when route tracing is done
''' </summary>
Public Event Done As EventHandler
''' <summary>
''' Fires when a node is found in the route
''' </summary>
Public Event RouteNodeFound As EventHandler(Of RouteNodeFoundEventArgs)
Public Sub New()
'Default timeout of Ping
_timeout = 5000
End Sub
Private _maxHops As Integer = 30
Public Property MaxHops() As Integer
Get
Return _maxHops
End Get
Set(ByVal value As Integer)
_maxHops = value
End Set
End Property
''' <summary>
''' The list of nodes in the route
''' </summary>
Public ReadOnly Property Nodes() As TracertNode()
Get
SyncLock _nodes
Return _nodes.ToArray()
End SyncLock
End Get
End Property
Private _hostNameOrAddress As String
''' <summary>
''' The host name or address of the destination node
''' </summary>
Public Property HostNameOrAddress() As String
Get
Return _hostNameOrAddress
End Get
Set(ByVal value As String)
_hostNameOrAddress = value
End Set
End Property
Private _timeout As Integer
''' <summary>
''' The maximum amount of time to wait for the Ping request to an intermediate node
''' </summary>
Public Property TimeOut() As Integer
Get
Return _timeout
End Get
Set(ByVal value As Integer)
_timeout = value
End Set
End Property
''' <summary>
''' Indicates whether the route tracing is complete
''' </summary>
Public Property IsDone() As Boolean
Get
Return _isDone
End Get
Private Set(ByVal value As Boolean)
_isDone = value
Try
If value Then
RaiseEvent Done(Me, EventArgs.Empty)
End If
Catch
End Try
If _isDone Then
Dispose()
End If
End Set
End Property
Shared _buffer As Byte()
Private Shared ReadOnly Property Buffer() As Byte()
Get
If _buffer Is Nothing Then
_buffer = New Byte(31) {}
For i As Integer = 0 To _buffer.Length - 1
_buffer(i) = &H65
Next
End If
Return _buffer
End Get
End Property
''' <summary>
''' Starts the route tracing process. The HostNameOrAddress field should already be set
''' </summary>
Public Sub Trace()
If _ping IsNot Nothing Then
Throw New InvalidOperationException("This object is already in use")
End If
_nodes = New List(Of TracertNode)()
_destination = Dns.GetHostEntry(_hostNameOrAddress).AddressList(0)
If IPAddress.IsLoopback(_destination) Then
ProcessNode(_destination, IPStatus.Success)
Else
_ping = New Ping()
AddHandler _ping.PingCompleted, New PingCompletedEventHandler(AddressOf OnPingCompleted)
_options = New PingOptions(1, True)
_ping.SendAsync(_destination, _timeout, ctrlTraceRoute.Buffer, _options, Nothing)
End If
End Sub
Private Sub OnPingCompleted(ByVal sender As Object, ByVal e As PingCompletedEventArgs)
ProcessNode(e.Reply.Address, e.Reply.Status)
_options.Ttl += 1
If Not Me.IsDone Then
SyncLock Me
'The expectation was that SendAsync will throw an exception
If _ping Is Nothing Then
ProcessNode(_destination, IPStatus.Unknown)
Else
_ping.SendAsync(_destination, _timeout, ctrlTraceRoute.Buffer, _options, Nothing)
End If
End SyncLock
End If
End Sub
Protected Sub ProcessNode(ByVal address As IPAddress, ByVal status As IPStatus)
Dim roundTripTime As Long = 0
If status = IPStatus.TtlExpired OrElse status = IPStatus.Success Then
Dim pingIntermediate As New Ping()
Try
'Compute roundtrip time to the address by pinging it
Dim reply As PingReply = pingIntermediate.Send(address, _timeout)
roundTripTime = reply.RoundtripTime
status = reply.Status
Catch e As PingException
'Do nothing
System.Diagnostics.Trace.WriteLine(e)
Finally
pingIntermediate.Dispose()
End Try
End If
Dim node As New TracertNode(address, roundTripTime, status)
SyncLock _nodes
_nodes.Add(node)
End SyncLock
RaiseEvent RouteNodeFound(Me, New RouteNodeFoundEventArgs(node, Me.IsDone))
Me.IsDone = address.Equals(_destination)
SyncLock _nodes
If Not Me.IsDone AndAlso _nodes.Count >= _maxHops - 1 Then
ProcessNode(_destination, IPStatus.Success)
End If
End SyncLock
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
SyncLock Me
If _ping IsNot Nothing Then
_ping.Dispose()
_ping = Nothing
End If
End SyncLock
Finally
MyBase.Dispose(disposing)
End Try
End Sub
End Class