Solved

tracert

Posted on 2002-04-01
8
636 Views
Last Modified: 2006-11-17
If i have a machine name, how do I do tracert to that machine in VB ocde?  Working code needed please.

Thanks!
hxia
0
Comment
Question by:hxia
  • 3
  • 3
  • 2
8 Comments
 
LVL 45

Expert Comment

by:aikimark
ID: 6910834
what is "tracert"?
0
 

Author Comment

by:hxia
ID: 6910846
"tracert" is a DOS command to trace routes between 2 machines.

hxia
0
 
LVL 45

Expert Comment

by:aikimark
ID: 6910914
Freebie code samples or (wrapper) controls
http://www.allapi.net/vbexamples/vbexample.php?vbexample=TRACERT&category=SOURCE
http://www.aspfree.com/authors/robert/default.asp?aid=51
http://jimhuff.dsl.shentel.net/vbWinSck/vbWinSck.HTM

Low-tech approach:
You can also Shell("tracert " & strmachinename & " > " & App.Path & "\paths.lst")
and then read/process the resulting file.
0
 
LVL 3

Accepted Solution

by:
msterjev earned 50 total points
ID: 6912396

http://www.mvps.org/vbnet/code/internet/tracerthost.htm

Look at ping implementations and a lot of VB Network code at:

http://www.mvps.org/vbnet
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 3

Expert Comment

by:msterjev
ID: 6912399
Or here is the code:
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright )1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const WSADescription_Len As Long = 255  '256, 0-based
Private Const WSASYS_Status_Len As Long = 127   '128, 0-based
Private Const WS_VERSION_REQD As Long = &H101
Private Const SOCKET_ERROR As Long = -1
Private Const AF_INET As Long = 2
Private Const IP_SUCCESS As Long = 0
Private Const MIN_SOCKETS_REQD As Long = 1
Public Const EM_SETTABSTOPS As Long = &HCB

Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To WSADescription_Len) As Byte
   szSystemStatus(0 To WSASYS_Status_Len) As Byte
   imaxsockets As Integer
   imaxudp As Integer
   lpszvenderinfo As Long
End Type

Public Type ICMP_OPTIONS
   ttl             As Byte         'Time To Live
   Tos             As Byte         'Timeout
   Flags           As Byte         'option flags
   OptionsSize     As Long         '
   OptionsData     As Long         '
End Type

Public Type ICMP_ECHO_REPLY
   Address         As Long         'replying address
   Status          As Long         'reply status code
   RoundTripTime   As Long         'round-trip time, in milliseconds
   datasize        As Integer      'reply data size. Always an Int.
   Reserved        As Integer      'reserved for future use
   DataPointer     As Long         'pointer to the data in Data below
   Options         As ICMP_OPTIONS 'reply options, used in tracert
   ReturnedData    As String * 256 'the returned data follows the
                                    'reply message. The data string
                                    'must be sufficiently large enough
                                    'to hold the returned data.
End Type

Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
   
Private Declare Function WSAStartup Lib "wsock32" _
  (ByVal VersionReq As Long, _
   WSADataReturn As WSADATA) As Long
 
Private Declare Function WSACleanup Lib "wsock32" () As Long

Public Declare Function inet_addr Lib "wsock32" _
  (ByVal s As String) As Long

Private Declare Function gethostbyaddr Lib "wsock32" _
  (haddr As Long, _
   ByVal hnlen As Long, _
   ByVal addrtype As Long) As Long
 
Private Declare Function gethostname Lib "wsock32" _
   (ByVal szHost As String, _
    ByVal dwHostLen As Long) As Long
   
Private Declare Function gethostbyname Lib "wsock32" _
   (ByVal szHost As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Dest As Any, _
   Source As Any, _
   ByVal nbytes As Long)

Private Declare Function inet_ntoa Lib "wsock32.dll" _
   (ByVal addr As Long) As Long

Private Declare Function lstrcpyA Lib "kernel32" _
  (ByVal RetVal As String, _
   ByVal Ptr As Long) As Long
                       
Private Declare Function lstrlenA Lib "kernel32" _
  (ByVal Ptr As Any) As Long
 
Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

Public Declare Function IcmpCloseHandle Lib "icmp.dll" _
   (ByVal IcmpHandle As Long) As Long
   
Public Declare Function IcmpSendEcho Lib "icmp.dll" _
   (ByVal IcmpHandle As Long, _
    ByVal DestinationAddress As Long, _
    ByVal RequestData As String, _
    ByVal RequestSize As Long, _
    RequestOptions As ICMP_OPTIONS, _
    ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, _
    ByVal Timeout As Long) As Long
   

Public Function GetIPFromHostName(ByVal sHostName As String) As String

  'converts a host name to an IP address.

   Dim ptrHosent As Long      'address of hostent structure
   Dim ptrName As Long        'address of name pointer
   Dim ptrAddress As Long     'address of address pointer
   Dim ptrIPAddress As Long   'address of string holding final IP address
   Dim dwAddress As Long      'the final IP address
   
   ptrHosent = gethostbyname(sHostName & vbNullChar)

   If ptrHosent <> 0 Then

     'assign pointer addresses and offset
     
     'ptrName is the official name of the host (PC).
     'If using the DNS or similar resolution system,
     'it is the Fully Qualified Domain Name (FQDN)
     'that caused the server to return a reply.
     'If using a local hosts file, it is the first
     'entry after the IP address.
      ptrName = ptrHosent
     
     'Null-terminated list of addresses for the host.
     'The Address is offset 12 bytes from the start of
     'the HOSENT structure. Addresses are returned
     'in network byte order.
      ptrAddress = ptrHosent + 12
     
     'get the actual IP address
      CopyMemory ptrAddress, ByVal ptrAddress, 4
      CopyMemory ptrIPAddress, ByVal ptrAddress, 4
      CopyMemory dwAddress, ByVal ptrIPAddress, 4

      GetIPFromHostName = GetIPFromAddress(dwAddress)

   End If
   
End Function


Public Sub SocketsCleanup()
   
  'only show error if unable to clean up the sockets
   If WSACleanup() <> 0 Then
       MsgBox "Windows Sockets error occurred during Cleanup.", vbExclamation
   End If
   
End Sub


Public Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA
   
  'when the socket version returned == version
  'required, return True
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
   
End Function


Public Function GetIPFromAddress(Address As Long) As String
   
   Dim ptrString As Long
   
   ptrString = inet_ntoa(Address)
   GetIPFromAddress = GetStrFromPtrA(ptrString)
   
End Function


Public Function GetStrFromPtrA(ByVal lpszA As Long) As String

   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
   
End Function
'--end block--'
 
 
 Form Code
 
To a form add a command button (Command1), check box (disabled - Check1), a combo (Combo1) and four text boxes (Text1 - Text 4). Text 4 is the tracert output box. Label as desired, and add the following code:

--------------------------------------------------------------------------------
 
Option Explicit

Public Sub Form_Load()

    With Combo1
      .AddItem "www.mvps.org"
      .AddItem "www.gov.on.ca"
      .AddItem "www.microsoft.com"
      .AddItem "www.yahoo.com"
      .ListIndex = 1
   End With

   Text1.Text = ""
   Text4.Text = ""
   
   ReDim TabArray(0 To 3) As Long
   
   TabArray(0) = 30
   TabArray(1) = 54
   TabArray(2) = 105
   TabArray(3) = 182
   
  'Clear existing tabs
  'and set the text tabstops
   Call SendMessage(Text4.hwnd, EM_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(Text4.hwnd, EM_SETTABSTOPS, 4&, TabArray(0))
   Text4.Refresh

End Sub


Public Sub Command1_Click()
   
   Command1.Enabled = False
   Call TraceRT
   Command1.Enabled = True
   
End Sub


Public Function TraceRT()

   Dim ipo As ICMP_OPTIONS
   Dim echo As ICMP_ECHO_REPLY
   Dim ttl As Integer
   Dim ttlAdjust As Integer
   Dim hPort As Long
   Dim nChrsPerPacket As Long
   Dim dwAddress As Long
   Dim sAddress As String
   Dim sHostIP As String

  'set up
   Text1.Text = ""  'the target IP
   Text2.Text = "1" 'force the no of packets = 1 for a tracert
   Text4.Text = ""  'clear the output window
   List1.Clear      'for info/debuging only
   
  'the chars per packet - can be between 32 and 128
   If IsNumeric(Text3.Text) Then
      If Val(Text3.Text) < 32 Then Text3.Text = "32"
      If Val(Text3.Text) > 128 Then Text3.Text = "128"
   Else
      Text3.Text = "32"
   End If
   
   nChrsPerPacket = Val(Text3.Text)
   
   If SocketsInitialize() Then
   
     'returns the IP Address for the Host in Combo 1
     'ie returns 209.68.48.118 for www.mvps.org
      sAddress = GetIPFromHostName(Combo1.Text)
   
     'convert the address into an internet address.
     'ie returns 1982874833 when passed 209.68.48.118
      dwAddress = inet_addr(sAddress)
     
     'open an internet file handle
      hPort = IcmpCreateFile()
     
      If hPort <> 0 Then
   
        'update the textboxes
         Text1.Text = sAddress
         Text4.Text = "Tracing Route to " + Combo1.Text + ":" & vbCrLf & vbCrLf
   
        'The heart of the call. See the VBnet
        'page description of the TraceRt TTL
        'member and its use in performing a
        'Trace Route.
         For ttl = 1 To 255
         
           '--------------------------------
           'for demo/dedbugging only. The
           'list will show each TTL passed
           'to the calls. Duplicate TTL's
           'mean the request timed out, and
           'additional attempts to obtain
           'the route were tried.
            List1.AddItem ttl
           '--------------------------------
           
           'set the IPO time to live
           'value to the current hop
            ipo.ttl = ttl
     
           'Call the API.
           '
           'Two items of consequence happen here.
           'First, the return value of the call is
           'assigned to an 'adjustment' variable. If
           'the call was successful, the adjustment
           'is 0, and the Next will increment the TTL
           'to obtain the next hop. If the return value
           'is 1, 1 is subtacted from the TTL value, so
           'when the next increments the TTL counter it
           'will be the same value as the last pass. In
           'doing this, routers that time out are retried
           'to ensure a completed route is determined.
           '(The values in the List1 show the actual
           ' hops/tries that the method made.)
           'i.e. if the TTL = 3 and it times out,
           '     adjust = 1 so ttl - 1 = 2. On
           '     encountering the Next, TTL is
           '     reset to 3 and the route is tried again.
           
           'The second thing happening concerns the
           'sHostIP member of the call. When the call
           'returns, sHostIP will contain the name
           'of the traced host IP.  If it matches the
           'string initially used to create the address
           '(above) were at the target, so end.
            ttlAdjust = TraceRTSendEcho(hPort, _
                                        dwAddress, _
                                        nChrsPerPacket, _
                                        sHostIP, _
                                        echo, _
                                        ipo)
     
            ttl = ttl - ttlAdjust
           'need some processing time
            DoEvents
       
            If sHostIP = Text1.Text Then

              'we're done
               Text4.Text = Text4.Text & vbCrLf + "Trace Route Complete"
               Exit For

            End If

         Next ttl

        'clean up
         Call IcmpCloseHandle(hPort)
   
      Else: MsgBox "Unable to Open an Icmp File Handle", vbOKOnly, "VBnet TraceRT Demo"
      End If  'If hPort
   
     'clean up
      Call SocketsCleanup
     
   Else: MsgBox "Unable to initialize the Windows Sockets", vbOKOnly, "VBnet TraceRT Demo"
   End If  'if SocketsInitialize()

End Function


Private Sub ShowResults(timeToLive As Byte, _
                        tripTime As Long, _
                        sHostIP As String)
   
   Dim sTripTime As String
   Dim buff As String
   Dim tmp As String

  'format a string representing
  'the round trip time
   Select Case tripTime
      Case Is < 10:   sTripTime = "<10 ms"
      Case Is > 1200: sTripTime = "*"
      Case Else:      sTripTime = CStr(tripTime) & " ms"
   End Select
   
  'cache the textbox
   buff = Text4.Text
   
  'create a new entry
   tmp = "Hop #" & vbTab & _
          CStr(timeToLive) & vbTab & _
          sTripTime & vbTab & _
          sHostIP & vbCrLf

  'update textbox
   Text4.Text = buff & tmp
   
End Sub


Private Function TraceRTSendEcho(hPort As Long, _
                                 dwAddress As Long, _
                                 nChrsPerPacket As Long, _
                                 sHostIP As String, _
                                 echo As ICMP_ECHO_REPLY, _
                                 ipo As ICMP_OPTIONS) As Integer

   Dim sData As String
   Dim sError As String
   Dim sHostName As String
   Dim ttl As Integer
   
  'create a buffer to send
   sData = String$(nChrsPerPacket, "a")
                   
   If IcmpSendEcho(hPort, _
                   dwAddress, _
                   sData, _
                   Len(sData), _
                   ipo, _
                   echo, _
                   Len(echo) + 8, _
                   2400) = 1 Then
   
      'a reply was received, so update the display
       sHostIP = GetIPFromAddress(echo.Address)
             
       ShowResults ipo.ttl, echo.RoundTripTime, sHostIP
       
      'return 0 to continue with retrieval
       TraceRTSendEcho = 0
     
   Else
     
      'a timeout was received, so set the
      'return value to 1. In the TraceRT
      'calling routine, the TTL will be
      'de-incremented by 1, causing the
      'for / next to retry this hop.
       TraceRTSendEcho = 1
   
   End If
       
End Function
'--end block--'
 
0
 

Author Comment

by:hxia
ID: 6913750
aikimark,

I tired Shell("tracert " & strmachinename & " > " & App.Path & "\paths.lst"), it didn't work.

Dim MachineName As String
Dim ReturnCode As Integer
MachineName = "gluon"
ReturnCode = Shell("tracert " & MachineName & " > " & "c:\vbwork\traceroute\tracert.txt")

It did not write anything to the file.  "gluon" is a working machine, I could tracert it under DOS.

Thanks,
hxia


0
 

Author Comment

by:hxia
ID: 6913833
Thanks!
0
 
LVL 45

Expert Comment

by:aikimark
ID: 6914181
hxla,

If you need to launch a DOS-level command/utility with the Shell function, use: "cmd /c " before the command
in this case:
"cmd /c tracert " & MachineName & " > " & "c:\vbwork\traceroute\tracert.txt")
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Suggested Solutions

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now