-----------------------------------------------------------------------------------
Copy the code below and host on your website as "TraceRouteMesh.ashx".
Notice the .ashx extension, this is a Generic Handler, not a standard page class.
-----------------------------------------------------------------------------------
<%@ WebHandler Language="VB" Class="TraceRouteMesh" %>
'/ VB.NET version of Perry Lorier's Traceroute Mesh utility.
'/ Trace.CS code originally written by Sanjay Ahuja.
'/ 2009-11-11 Written by Sam Norris, http://www.ChangeIP.com & http://www.MyServer.org
'/ 2009-11-11 Initial version release.
Imports System
Imports System.Web
Imports System.Net
Imports System.Net.Sockets
Public Class TraceRouteMesh : Implements IHttpHandler
Public Sub ProcessRequest(ByVal context As HttpContext) Implements IHttpHandler.ProcessRequest
If context.Request("ip") Is Nothing Then
'/ HTML output below.
context.Response.ContentType = "text/html"
context.Response.Write("<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">" & _
"<html><head>" & _
"<title>Traceroute Mesh Server</title>" & _
"<style>" & _
"body {" & _
" background: #e0e0f0;" & _
"}" & _
"iframe {" & _
" background: #ffffff;" & _
" -moz-border-radius: 10pt;" & _
"}" & _
".error {" & _
" background: #ffffff;" & _
" border: 2px red solid;" & _
" -moz-border-radius: 10pt;" & _
" padding: 20pt;" & _
" text-align: center;" & _
"}" & _
"</style>" & _
"</head><body>" & _
"" & _
"<iframe src=""http://tr.meta.net.nz/server.php?magic=more+magic&version=7"" width=""100%"" height=""100%""/>" & _
"" & _
"</body></html>")
Else
'/ If an IP was submitted switch to plain text output and do the traceroute.
context.Response.ContentType = "text/plain"
TraceRoute(context.Request("ip"), context)
End If
End Sub
Public ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable
Get
Return False
End Get
End Property
'/ Code below taken from Trace.CS witten by Sanjay Ahuja.
'/ Modification from console app to handler and format requirements by Sam Norris.
'*****************************************************************************************************************
'* Class: Trace
'* Description: Traces path of an ip packet with its respond time
'* Author: Sanjay Ahuja
'* Date: 5/15/2002
'* Copyright�: � 2002, Sanjay Ahuja (lparam@hotmail.com). Use it as you want till you leave my name intact
'/*****************************************************************************************************************
Private Structure ICMPConstants
Public Const ICMP_ECHOREPLY As Integer = 0 ' Echo reply query
Public Const ICMP_TIMEEXCEEDED As Integer = 11 ' TTL exceeded error
Public Const ICMP_ECHOREQ As Integer = 8 ' Echo request query
Public Const MAX_TTL As Integer = 30 ' Max TTL
Public _temp As String ' Required by VB in Structures
End Structure
Private Structure ICMP
Public type As Byte ' Type
Public code As Byte ' Code
Public checksum As UShort ' Checksum
Public id As UShort ' Identification
Public seq As UShort ' Sequence
End Structure
' ICMP Echo Request, size is 12+ 32 (PACKET_SIZE as defined in class Trace)= 44 bytes
Private Structure REQUEST
Public m_icmp As ICMP
Public m_data As Byte()
End Structure
Const PACKET_SIZE As Integer = 32
Private Sub TraceRoute(ByVal DestIP As String, ByVal context As HttpContext)
' Verify Destination
If DestIP Is Nothing Then
context.Response.Write("Please submit a valid hostname or IP address.")
Exit Sub
End If
'Create Raw ICMP Socket
Using s As New Socket(AddressFamily.InterNetwork, SocketType.Raw, ProtocolType.Icmp)
Dim ipdest As IPEndPoint
Try
ipdest = New IPEndPoint(Dns.Resolve(DestIP).AddressList(0), 80)
Catch ex As Exception
'/ If the hostname or IP address doesn't resolve then fail out now.
context.Response.Write("Hostname lookup failed." & vbLf)
s.Close()
Exit Sub
End Try
'Source
Dim ipsrc As New IPEndPoint(Dns.GetHostByName(Dns.GetHostName()).AddressList(0), 80)
Dim epsrc As EndPoint = DirectCast(ipsrc, EndPoint)
'/ Output header.
context.Response.Write(String.Format("traceroute to {0} ({1}), {2} hops max, {3} byte packets", _
DestIP, DirectCast(ipdest, IPEndPoint).Address, ICMPConstants.MAX_TTL, PACKET_SIZE) & vbLf)
Dim ip As New ICMP()
ip.type = ICMPConstants.ICMP_ECHOREQ
ip.code = 0
ip.checksum = 0
ip.id = CUShort(DateTime.Now.Millisecond)
ip.seq = 0
Dim req As New REQUEST()
req.m_icmp = ip
req.m_data = New [Byte](PACKET_SIZE - 1) {}
'Initialize data
For i As Integer = 0 To req.m_data.Length - 1
req.m_data(i) = CByte(Val("S"c))
Next
'this function would get byte array from the REQUEST structure
Dim ByteSend As [Byte]() = CreatePacket(req)
'/ start a failure counter so we can quit after 3 fails.
Dim fail As Integer = 0
' Send requests with increasing number of TTL.
For ittl As Integer = 1 To ICMPConstants.MAX_TTL
Dim ByteRecv As [Byte]() = New [Byte](255) {}
'/ Socket options to set TTL and Timeouts
'/ Use 100ms timeouts so that we return a result quickly.
s.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.IpTimeToLive, ittl)
s.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.SendTimeout, 100)
s.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReceiveTimeout, 100)
Try
Dim dt As DateTime = DateTime.Now
Dim iRet As Integer = s.SendTo(ByteSend, ByteSend.Length, SocketFlags.None, ipdest)
'check for Win32 SOCKET_ERROR
If iRet = -1 Then
context.Response.Write("error sending packet." & vbLf)
Exit For
End If
'Receive
iRet = s.ReceiveFrom(ByteRecv, ByteRecv.Length, SocketFlags.None, epsrc)
'Calculate time required
Dim ts As TimeSpan = DateTime.Now - dt
'check if response is OK
If iRet = -1 Then
context.Response.Write("error getting data." & vbLf)
Exit For
End If
'/ reset fail counter.
fail = 0
'/ Output a line for this hop.
context.Response.Write(String.Format("{0,3} {1} {2} ms", ittl, DirectCast(epsrc, IPEndPoint).Address, ts.Milliseconds) & vbLf)
'reply size should be sizeof REQUEST + 20 (i.e sizeof IP header),it should be an echo reply
'and id should be same
If (iRet = PACKET_SIZE + 8 + 20) AndAlso _
(BitConverter.ToInt16(ByteRecv, 24) = BitConverter.ToInt16(ByteSend, 4)) AndAlso _
(ByteRecv(20) = ICMPConstants.ICMP_ECHOREPLY) Then
Exit For
End If
'time out
If ByteRecv(20) <> ICMPConstants.ICMP_TIMEEXCEEDED Then
context.Response.Write("unexpected reply, quitting." & vbLf)
Exit For
End If
Catch e As SocketException
'/ Increment failed hops.
fail += 1
'/ Write out * for failed hops.
If e.SocketErrorCode = SocketError.TimedOut Then
context.Response.Write(String.Format("{0,3} {1} {2} ms", ittl, "*", 0) & vbLf)
Else
context.Response.Write(String.Format("{0,3} {1} {2} ms", ittl, e.Message, 0) & vbLf)
End If
'/ Stop tracing if we're not getting anywhere.
If fail >= 3 Then Exit For
Catch e As Exception
'/ If there is an exception other than sockets then fail immediately.
context.Response.Write(String.Format("{0,3} {1} {2} ms", ittl, e.Message, 0) & vbLf)
Exit For
End Try
Next
End Using
End Sub
Private Function CreatePacket(ByVal req As REQUEST) As Byte()
Dim ByteSend As [Byte]() = New [Byte](PACKET_SIZE + 7) {}
'Create Byte array from REQUEST structure
ByteSend(0) = req.m_icmp.type
ByteSend(1) = req.m_icmp.code
Array.Copy(BitConverter.GetBytes(req.m_icmp.checksum), 0, ByteSend, 2, 2)
Array.Copy(BitConverter.GetBytes(req.m_icmp.id), 0, ByteSend, 4, 2)
Array.Copy(BitConverter.GetBytes(req.m_icmp.seq), 0, ByteSend, 6, 2)
For i As Integer = 0 To req.m_data.Length - 1
ByteSend(i + 8) = req.m_data(i)
Next
'calculate checksum
Dim iCheckSum As Integer = 0
For i As Integer = 0 To ByteSend.Length - 1 Step 2
iCheckSum += Convert.ToInt32(BitConverter.ToUInt16(ByteSend, i))
Next
iCheckSum = (iCheckSum >> 16) + (iCheckSum And &HFFFF)
iCheckSum += (iCheckSum >> 16)
'update byte array to reflect checksum
Array.Copy(BitConverter.GetBytes(CShort(Not iCheckSum)), 0, ByteSend, 2, 2)
Return ByteSend
End Function
End Class