-----------------------------------------------------------------------------------
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
 
 
 

Skip Navigation LinksHome > Utilities > TraceRoute Mesh Source

Copyright ©MyServer.org, 2000-2017   All Rights Reserved Contact Us   |   Site Map   |   Login   |   Terms of Use   |   Privacy Policy
8/18/2017 11:07:04 AM