source.tightDev.net Because you don't need to be big, rich and famous to create something great.

Content of "\FastTraceRt\App.vb"

Imports System.Net

''' <summary>Application module.</summary>
Friend Module App

#Region "  Application configuration  "

	''' <summary>The absolute maximum of hops (time to live) to trace.</summary>
	Private MaxTTL As Integer = 100

	''' <summary>The maximum of following failures during trace.</summary>
	Private MaxFailed As Integer = 10

	''' <summary>The maximum of following timeouts during trace.</summary>
	Private MaxTimeout As Integer = 3

	''' <summary>The timeout for the ping (in mSec).</summary>
	Private Timeout As Integer = 1000

	''' <summary>The update interval for the console (in mSec).</summary>
	Private UpdateInterval As Integer = 250

	''' <summary>The size of the data to send.</summary>
	Private Size As Integer = 32

	''' <summary>The format for the information header.</summary>
	Private Const InfoFormat As String = " {0,14}"

	''' <summary>The format for the table header.</summary>
	Private HeaderFormat As String = "  {0,-3}  {1,-7}  {2,-15}  {3,-45}"

	''' <summary>The format for the table output (the result).</summary>
	Private TableFormat As String = "  {0,3}  {1,4} ms  {2,-15}  {3,-45}"

	''' <summary>The index of the animation to use, or 0 to do not show it. Possible values: 0..4.</summary>
	Private Const AnimationType As Integer = 1

#End Region
#Region "  Private variables  "

	''' <summary>The IP address to trace. Provided by arguments.</summary>
	Private Target As IPHostEntry

	''' <summary>The collected data store.</summary>
	Private Hosts As New Collections.Generic.List(Of HostState)

	''' <summary>Locking object for the console output.</summary>
	Private ConsoleLock As New Object

	''' <summary>The Y offset for the console output. Line = Offset + TTL.</summary>
	Private YOffset As Integer

	''' <summary>The timer which updates the console output.</summary>
	Private WithEvents UpdateTimer As Threading.Timer

	''' <summary>List of threads which resolves the host name.</summary>
	Private ResolveThreads As New Collections.Generic.List(Of Threading.Thread)

	''' <summary>List of threads which pings the hosts.</summary>
	Private PingThreads As New Collections.Generic.List(Of Threading.Thread)

	''' <summary>Because Thread.Join does not work like excepted, this variable holds the number of active threads to wait for.</summary>
	Private Waits As Integer

	''' <summary>Locking object wor Waits variable.</summary>
	Private WaitsLock As New Object

	''' <summary>If set to true the application waits for exit (useful if started from Windows instead of console).</summary>
	''' <remarks></remarks>
	Private WaitForExit As Boolean

#End Region
#Region "  Main application and it's event handlers  "

	''' <summary>Main entry point of the application.</summary>
	''' <param name="Args">Arguments provided during starting the application.</param>
	''' <returns>Usually 0. 1 if no Host or IP was specified, 2 if it was invalid or unknown.</returns>
	Friend Function Main(ByVal Args As String()) As Integer

		' Show header
		SyncLock ConsoleLock
			Console.CursorVisible = False
			Console.ForegroundColor = ConsoleColor.Gray
			Console.WriteLine(" ╔════════════════════════════════════════════════════════════════════════════╗")
			Console.WriteLine(" ║                                                                            ║")
			Console.Write(" ║")
			Console.ForegroundColor = ConsoleColor.White
			Console.Write("                           Fast TraceRoute  v2.1                            ")
			Console.ForegroundColor = ConsoleColor.Gray
			Console.WriteLine("║")
			Console.WriteLine(" ║                                                                            ║")
			Console.WriteLine(" ╟────────────────────────────────────────────────────────────────────────────╢")
			Console.WriteLine(" ║                           (C) 2017 tightDev.Net                            ║")
			Console.WriteLine(" ╚════════════════════════════════════════════════════════════════════════════╝")
			Console.ResetColor()
			Console.WriteLine()
		End SyncLock

		' Validate argument(s)
		Dim HostOrIP As String
		If Args.Length <= 0 Then
			SyncLock ConsoleLock
				WaitForExit = True
				SyncLock ConsoleLock
					Console.Write(" Enter host name or ip address to trace: ")
					Console.CursorVisible = True
					HostOrIP = Console.ReadLine
					Console.CursorVisible = False
					Console.WriteLine()
				End SyncLock
			End SyncLock
		Else
			HostOrIP = Args(0)
		End If

		' Process arguments
		Try
			Target = Dns.GetHostEntry(HostOrIP)
		Catch ex As Exception
			SyncLock ConsoleLock
				Console.ForegroundColor = ConsoleColor.Red
				Console.WriteLine(" ERROR: Invalid Hostname or IP address!")
				Console.ResetColor()
				Console.WriteLine()
			End SyncLock
			If WaitForExit Then
				Console.WriteLine(" Press any key to exit...")
				Console.ReadKey(True)
			End If
			Return 1
		End Try

		' Show info
		SyncLock ConsoleLock
			Console.ForegroundColor = ConsoleColor.White
			Console.Write(String.Format(InfoFormat, "Tracing Host: "))
			Console.ResetColor()
			Console.WriteLine(GetHostName(Target.HostName))
			For Each IP As IPAddress In Target.AddressList
				Console.ForegroundColor = ConsoleColor.White
				Console.Write(String.Format(InfoFormat, "IP: "))
				Console.ResetColor()
				Console.WriteLine(IP.ToString)
			Next
			Console.WriteLine()
			Console.ForegroundColor = ConsoleColor.White
			Console.WriteLine(String.Format(HeaderFormat, "Hop", "Ping", "IP", "Host"))
			Console.ResetColor()
			Console.Write(" " & New String("─"c, 78))
		End SyncLock

		' Get console y offset
		YOffset = Console.CursorTop

		' Start console updating
		UpdateTimer = New Threading.Timer(AddressOf OnTick, Nothing, UpdateInterval, UpdateInterval)

		' Start the magic
		Dim TTL As Integer
		Dim Failed As Integer
		Dim TimedOut As Integer
		Dim AddEntry As Boolean
		Dim Finished As Boolean
		Dim IsTtlExceeded As Boolean
		Dim IsErrorExceeded As Boolean
		Do While (Not Finished) AndAlso (TTL < MaxTTL) AndAlso (Failed < MaxFailed)
			Dim Reply As NetworkInformation.PingReply = PerformPing(Target.HostName, TTL + 1)
			Select Case Reply.Status
				Case NetworkInformation.IPStatus.TtlExpired
					' Destination not reached, continue
					TTL += 1
					TimedOut = 0
					Failed = 0
					AddEntry = True
				Case NetworkInformation.IPStatus.Success
					' We got the host
					TTL += 1
					AddEntry = True
					Finished = True	' to gracefully exit. Exit Do would not set the target host.
				Case NetworkInformation.IPStatus.TimedOut
					' We are timed out. Retry.
					TimedOut += 1
					AddEntry = False
					If TimedOut >= MaxTimeout Then
						AddEntry = True
						TTL += 1		' Too much timeouts, continue
						Failed += 1	' And increment failure counter
						TimedOut = 0
					End If
				Case Else
					Failed += 1
					TimedOut = 0
			End Select
			If Failed >= MaxFailed Then
				IsErrorExceeded = True
			End If
			If TTL >= MaxTTL Then
				IsTtlExceeded = True
			End If
			If AddEntry Then
				Dim Entry As New HostState With { _
				  .Index = TTL, _
				  .IP = If(Reply.Status = NetworkInformation.IPStatus.TimedOut, "(unknown)", Reply.Address.ToString), _
				  .Result = Reply, _
				  .IsDirty = True _
				}
				SyncLock Hosts
					Hosts.Add(Entry)
				End SyncLock
				Dim ResolveThread As New Threading.Thread(AddressOf Resolver)
				ResolveThreads.Add(ResolveThread)
				ResolveThread.Start(Entry)
				Dim PingThread As New Threading.Thread(AddressOf Pinger)
				PingThreads.Add(ResolveThread)
				PingThread.Start(Entry)
			End If
		Loop

		' Wait for all threads to finish
		Dim Completed As Boolean
		Do
			Threading.Thread.Sleep(100)
			SyncLock WaitsLock
				Completed = (Waits <= 0)
			End SyncLock
			If Completed Then Exit Do
		Loop

		' Stop update timer
		UpdateTimer.Dispose()

		' Force redraw
		For Each Item As HostState In Hosts
			Item.IsDirty = True
		Next
		Call OnTick(Nothing)

		' Set console cursor position after output
		Console.SetCursorPosition(0, YOffset + Hosts(Hosts.Count - 1).Index + 1)
		Console.WriteLine(" " & New String("─"c, 78))
		Console.WriteLine()

		If IsErrorExceeded Then
			Console.ForegroundColor = ConsoleColor.Yellow
			Console.WriteLine(" WARNING: Maximum failures reached! Trace aborted.")
			Console.ResetColor()
			Console.WriteLine()
		End If
		If IsTtlExceeded Then
			Console.ForegroundColor = ConsoleColor.Yellow
			Console.WriteLine(" WARNING: Maximum Time To Live (TTL) reached! Trace aborted.")
			Console.ResetColor()
			Console.WriteLine()
		End If

		' If started from windows clear key buffer and ask for exit
		If WaitForExit Then
			Do While Console.KeyAvailable
				Console.ReadKey(True)
			Loop
			Console.WriteLine(" Press any key to exit...")
			Console.ReadKey(True)
		End If

		Return 0

	End Function

	''' <summary>Executed by UpdateTimer this sub will update the console output.</summary>
	''' <param name="state">The state object. Unused, always nothing.</param>
	Private Sub OnTick(ByVal state As Object)

		' Block access to hosts
		SyncLock Hosts

			' Loop through each host
			For Each Host As HostState In Hosts

				' If it's dirty (redraw needed)
				If Host.IsDirty Then

					' Lock console
					SyncLock ConsoleLock

						' Save current cursor position
						Dim LastY As Integer = Console.CursorTop
						Dim LastX As Integer = Console.CursorLeft

						' Draw the status for this host
						Dim RTT As String
						If Host.RTT = Integer.MinValue Then
							RTT = "?"
						ElseIf Host.RTT = Integer.MaxValue Then
							RTT = "*"
						ElseIf Host.RTT = 0 Then
							RTT = "<1"
						Else
							RTT = Host.RTT.ToString
						End If
						Console.SetCursorPosition(0, YOffset + Host.Index)
						If Host.Name.Equals("(unknown)") AndAlso Host.Result IsNot Nothing Then
							If Host.Result.Status <> NetworkInformation.IPStatus.TtlExpired Then Host.Name &= " Result: " & Host.Result.Status.ToString
						End If
						If Host.Name.StartsWith("(unknown)") AndAlso Host.Result IsNot Nothing Then
							Select Case Host.Result.Status
								Case NetworkInformation.IPStatus.TimedOut : Console.ForegroundColor = ConsoleColor.DarkYellow
								Case NetworkInformation.IPStatus.TtlExpired	' This is ok, don't change the color
								Case Else : Console.ForegroundColor = ConsoleColor.Red
							End Select
						End If
						Console.Write(String.Format(TableFormat, Host.Index, RTT, Host.IP, LimitString(Host.Name, 45)))
						Console.ResetColor()

						' Restore cursor position
						Console.SetCursorPosition(LastX, LastY)

					End SyncLock

					' We have updated the console, item is not dirty anymore
					Host.IsDirty = False

				End If

			Next

			'' Show a small animation indicating that we are still working # 1
			Call Animate(YOffset + Hosts(Hosts.Count - 1).Index + 1)

		End SyncLock

	End Sub

#End Region
#Region "  Private helper routines  "

	''' <summary>Performs a ping with a given TTL.</summary>
	''' <param name="HostOrIP">The host name or IP address to ping.</param>
	''' <param name="TTL">The time to live (TTL) for this ping.</param>
	''' <returns>Returns the <see cref="NetworkInformation.PingReply">PingReply</see> with additional informations.</returns>
	Private Function PerformPing(ByVal HostOrIP As String, ByVal TTL As Integer) As NetworkInformation.PingReply

		Dim Ping As New NetworkInformation.Ping
		Dim PingOption As New NetworkInformation.PingOptions
		Dim PingReply As NetworkInformation.PingReply = Nothing

		PingOption.DontFragment = True
		PingOption.Ttl = TTL
		Try
			PingReply = Ping.Send(HostOrIP, Timeout, CreateBuffer(Size), PingOption)
		Catch : End Try

		Return PingReply

	End Function

	''' <summary>Threaded task which resolves the host name from a IP address.</summary>
	''' <param name="state">The <see cref="HostState">HostState</see> to resolve the host name for.</param>
	Private Sub Resolver(ByVal state As Object)

		SyncLock WaitsLock
			Waits += 1
		End SyncLock

		Dim Item As HostState = DirectCast(state, HostState)
		Dim Name As String = GetHostName(Item.IP)

		SyncLock Hosts
			Item.Name = Name
			Item.IsDirty = True
		End SyncLock

		SyncLock WaitsLock
			Waits -= 1
		End SyncLock

	End Sub

	''' <summary>Threaded task which pings the host.</summary>
	''' <param name="state">The <see cref="HostState">HostState</see> to ping the host for.</param>
	Private Sub Pinger(ByVal state As Object)

		SyncLock WaitsLock
			Waits += 1
		End SyncLock

		Dim Item As HostState = DirectCast(state, HostState)
		Dim IP As String
		Dim Time As Integer = Integer.MaxValue

		' Get the IP
		SyncLock Hosts
			IP = Item.IP
		End SyncLock

		' Try to ping the host
		For i As Integer = 1 To MaxTimeout
			Dim Result As NetworkInformation.PingReply = PerformPing(IP, 255)
			If (Result IsNot Nothing) AndAlso Result.Status = NetworkInformation.IPStatus.Success Then
				Time = CInt(Result.RoundtripTime)
			End If
		Next

		' Set the ping value
		SyncLock Hosts
			Item.RTT = Time
			Item.IsDirty = True
		End SyncLock

		SyncLock WaitsLock
			Waits -= 1
		End SyncLock

	End Sub

	''' <summary>Creates a buffer with randomly filled data.</summary>
	''' <param name="Length">The length of the buffer.</param>
	''' <returns>Returns the created and filled buffer.</returns>
	Private Function CreateBuffer(ByVal Length As Integer) As Byte()

		Dim Buffer(Length - 1) As Byte
		Dim Rnd As New Random(Environment.TickCount)
		Rnd.NextBytes(Buffer)
		Return Buffer

	End Function

	''' <summary>Tries to resolve a host name by it's IP address.</summary>
	''' <param name="HostOrIP">The host to get the name from.</param>
	''' <returns>The name of the host or (if not found) the IP address.</returns>
	Private Function GetHostName(ByVal HostOrIP As String) As String

		Dim RetVal As String = HostOrIP
		Dim tmp As IPAddress = Nothing ' Dummy for TryParse

		' Old way, for IP input
		Try
			If IPAddress.TryParse(HostOrIP, tmp) Then
				RetVal = Dns.GetHostByAddress(HostOrIP).HostName
				If Not RetVal.Equals(HostOrIP) Then Return RetVal
			End If
		Catch : End Try

		' Old way, for Host input
		Try
			RetVal = Dns.Resolve(HostOrIP).HostName
			If Not RetVal.Equals(HostOrIP) Then Return RetVal
		Catch : End Try

		' New way (both), but does not handle local names very well.
		Try
			RetVal = Dns.GetHostEntry(HostOrIP).HostName
		Catch : End Try

		Return RetVal

	End Function

	''' <summary>Limits a string to a given length.</summary>
	''' <param name="Value">The string to limit.</param>
	''' <param name="MaxLength">The maximum length (chars) for the string.</param>
	''' <returns>Returns the limited string.</returns>
	Private Function LimitString(ByVal Value As String, ByVal MaxLength As Integer) As String

		If Value.Length <= MaxLength Then Return Value
		Return Value.Substring(0, MaxLength - 3) & "..."

	End Function

	''' <summary>Shows a little progress indicator at the bottom if set.</summary>
	''' <param name="Y">The console Y position where to draw to.</param>
	Private Sub Animate(ByVal Y As Integer)

		' Animation counter
		Static Ani As Integer = 0

		' Select animation mode
		Select Case AnimationType
			Case 0

				' No animation

			Case 1

				SyncLock ConsoleLock
					Console.SetCursorPosition(3, YOffset + Hosts(Hosts.Count - 1).Index + 1)
					Select Case Ani
						Case 0 : Console.Write("|")
						Case 1 : Console.Write("/")
						Case 2 : Console.Write("-")
						Case 3 : Console.Write("\")
					End Select
				End SyncLock
				Ani += 1
				If Ani >= 4 Then Ani = 0

			Case 2

				SyncLock ConsoleLock
					Console.SetCursorPosition(2, YOffset + Hosts(Hosts.Count - 1).Index + 1)
					Select Case Ani	' ░▒▓█
						Case 1 : Console.Write("█▓▒")
						Case 2 : Console.Write("▓█▓")
						Case 3 : Console.Write("▒▓█")
						Case 4 : Console.Write("░▒▓")
						Case 5 : Console.Write("▒░▒")
					End Select
				End SyncLock
				Ani += 1
				If Ani >= 6 Then Ani = 0

			Case 3

				SyncLock ConsoleLock
					Console.SetCursorPosition(2, YOffset + Hosts(Hosts.Count - 1).Index + 1)
					Select Case Ani	' ...
						Case 1 : Console.Write(".  ")
						Case 2 : Console.Write(" . ")
						Case 3 : Console.Write("  .")
					End Select
				End SyncLock
				Ani += 1
				If Ani >= 4 Then Ani = 0

			Case 4

				SyncLock ConsoleLock
					Console.SetCursorPosition(2, YOffset + Hosts(Hosts.Count - 1).Index + 1)
					Select Case Ani	' ...
						Case 1 : Console.Write("_/¯")
						Case 2 : Console.Write("/¯\")
						Case 3 : Console.Write("¯\_")
						Case 3 : Console.Write("\_/")
					End Select
				End SyncLock
				Ani += 1
				If Ani >= 4 Then Ani = 0

		End Select

	End Sub

#End Region

End Module