Note: This is not the complete source code--just the main source file.
You can download the full source (with include files) from our sample code archive by clicking on the diskette icons.

VbTrace.frm

VERSION 5.00
Begin VB.Form VbTrace 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "VbTrace"
   ClientHeight    =   6795
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   8670
   ClipControls    =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6795
   ScaleWidth      =   8670
   StartUpPosition =   1  'CenterOwner
   Begin VB.ComboBox cboHost 
      Height          =   315
      ItemData        =   "VbTrace.frx":0000
      Left            =   120
      List            =   "VbTrace.frx":0016
      TabIndex        =   0
      Top             =   360
      Width           =   3495
   End
   Begin VB.CommandButton cmd 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Enabled         =   0   'False
      Height          =   375
      Index           =   1
      Left            =   6480
      TabIndex        =   3
      Top             =   360
      Width           =   975
   End
   Begin VB.TextBox txtMaxHops 
      Height          =   285
      Left            =   3720
      TabIndex        =   1
      Text            =   "30"
      Top             =   360
      Width           =   975
   End
   Begin VB.TextBox txtOut 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4935
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   6
      Top             =   960
      Width           =   8415
   End
   Begin VB.CommandButton cmd 
      Caption         =   "&Exit"
      Height          =   375
      Index           =   2
      Left            =   7560
      TabIndex        =   4
      Top             =   360
      Width           =   975
   End
   Begin VB.CommandButton cmd 
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   5400
      TabIndex        =   2
      Top             =   360
      Width           =   975
   End
   Begin VB.Label lblLicenseB 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseB"
      Height          =   255
      Index           =   1
      Left            =   5280
      TabIndex        =   15
      Top             =   6480
      Width           =   2535
   End
   Begin VB.Label lblLicenseA 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseA"
      Height          =   255
      Index           =   1
      Left            =   5280
      TabIndex        =   14
      Top             =   6240
      Width           =   2535
   End
   Begin VB.Label lblVersion 
      BackStyle       =   0  'Transparent
      Caption         =   "version"
      Height          =   255
      Index           =   1
      Left            =   5280
      TabIndex        =   13
      Top             =   6000
      Width           =   2535
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "HexLookup"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   1
      Left            =   4080
      TabIndex        =   12
      Top             =   6000
      Width           =   1095
   End
   Begin VB.Label lblLicenseB 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseB"
      Height          =   255
      Index           =   0
      Left            =   1080
      TabIndex        =   11
      Top             =   6480
      Width           =   2535
   End
   Begin VB.Label lblLicenseA 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseA"
      Height          =   255
      Index           =   0
      Left            =   1080
      TabIndex        =   10
      Top             =   6240
      Width           =   2535
   End
   Begin VB.Label lblVersion 
      BackStyle       =   0  'Transparent
      Caption         =   "version"
      Height          =   255
      Index           =   0
      Left            =   1080
      TabIndex        =   9
      Top             =   6000
      Width           =   2535
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "HexIcmp"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   8
      Top             =   6000
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "Max hops"
      Height          =   255
      Left            =   3720
      TabIndex        =   7
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Host"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   1575
   End
End
Attribute VB_Name = "VbTrace"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'// Trace sample program
'//
'// Demonstrates use of HexIcmp and HexLookup
'//
'// Copyright (C) 1998 Hexillion Technologies. All rights reserved.
'//
Option Explicit
Dim m_oIcmp As HexIcmp
Dim m_oLkup As HexLookup
Dim m_bAbort As Boolean
Dim m_bExit As Boolean


Private Sub StartTrace()
    cmd(0).Enabled = False
    cmd(1).Enabled = True
    
    'Look up remote host, exit on failure
    Dim lAddr As Long, lRecvAddr As Long
    lAddr = m_oLkup.LookUp(cboHost)
    If 0 = lAddr Then
        txtOut = "Couldn't find host " & cboHost
        cmd(0).Enabled = True
        cmd(1).Enabled = False
        Exit Sub
    End If
    
    txtOut = "Tracing route to " & cboHost
    txtOut = txtOut & " [" & m_oLkup.AddrToString(lAddr) & "]" & vbCrLf & vbCrLf
    DoEvents
    
    Dim i As Integer, j As Integer, lRTT As Long, iMax As Integer
    m_bAbort = False
    iMax = Val(txtMaxHops)
    i = 0
    m_oIcmp.Timeout = 2000
    Do While lRecvAddr <> lAddr And i < iMax And Not m_bAbort
        i = i + 1
        txtOut = txtOut & i & ": "
        DoEvents
        
        lRecvAddr = 0
        m_oIcmp.SendTtl = i
        j = 0
        Do While j < 3 And Not m_bAbort
            j = j + 1
            lRTT = m_oIcmp.Ping(lAddr)
            If lRTT < 0 And m_oIcmp.Error <> hexIcmpErrTtlExpiredTransit Then
                Dim iErr As Integer
                iErr = m_oIcmp.Error
                Select Case iErr
                    Case hexIcmpErrDestHostUnreachable
                        txtOut = txtOut & " Host unreachable "
                        m_bAbort = True
                   Case hexIcmpErrDestNetUnreachable
                        txtOut = txtOut & " Network unreachable "
                        m_bAbort = True
                    Case hexIcmpErrSourceQuench
                        txtOut = txtOut & " Source quench "
                    Case hexIcmpErrReqTimedOut
                        txtOut = txtOut & " *  "
                    Case Else
                        txtOut = txtOut & "Err:" & iErr & " "
                        m_bAbort = True
                End Select
            Else
                lRecvAddr = m_oIcmp.RecvAddr
                txtOut = txtOut & m_oIcmp.RecvRtt & " "
            End If
            DoEvents
        Loop
        
        If m_bAbort Then Exit Do
        
        If lRecvAddr <> 0 Then
            txtOut = txtOut & "[" & m_oLkup.AddrToString(lRecvAddr) & "] "
            DoEvents
            txtOut = txtOut & m_oLkup.ReverseLookUp(lRecvAddr)
            DoEvents
        End If
        
        txtOut = txtOut & vbCrLf
    Loop
    
    cmd(0).Enabled = True
    cmd(1).Enabled = False
    
    If m_bExit Then Unload Me
End Sub

Private Sub cmd_Click(Index As Integer)
    Select Case Index
        Case 0:
            StartTrace
        Case 1:
            CancelTrace
        Case 2:
            If cmd(0).Enabled Then
                Unload Me
            Else
                m_bExit = True
                CancelTrace
            End If
    End Select
End Sub

Private Sub Form_Initialize()
    Set m_oIcmp = New HexIcmp
    Set m_oLkup = New HexLookup
    m_bExit = False
End Sub

Private Sub Form_Load()
    '// Display version and license information
    lblVersion(0) = m_oIcmp.Version
    If hexIcmpErrSuccess <> m_oIcmp.Error Then
        lblLicenseA(0) = GetLicenseErrorString(m_oIcmp.Error)
        lblLicenseB(0) = "Evaluation expires " & m_oIcmp.Expires
        
    ElseIf 0 = m_oIcmp.LicensedProcessors Then
        lblLicenseA(0) = "Runtime license"
        lblLicenseB(0) = ""
        
    Else
        lblLicenseA(0) = GetLicenseType(m_oIcmp.LicensedProcessors) & " license"
        lblLicenseB(0) = m_oIcmp.LicensedUser
    End If
    
    lblVersion(1) = m_oLkup.Version
    If hexLuErrSuccess <> m_oLkup.Error Then
        lblLicenseA(1) = GetLicenseErrorString(m_oLkup.Error)
        lblLicenseB(1) = "Evaluation expires " & m_oLkup.Expires
        
    ElseIf 0 = m_oLkup.LicensedProcessors Then
        lblLicenseA(1) = "Runtime license"
        lblLicenseB(1) = ""
        
    Else
        lblLicenseA(1) = GetLicenseType(m_oLkup.LicensedProcessors) & " license"
        lblLicenseB(1) = m_oLkup.LicensedUser
    End If
    
    cboHost.ListIndex = 0
End Sub


Private Sub Form_Terminate()
    Set m_oIcmp = Nothing
    Set m_oLkup = Nothing
    End
End Sub
Private Sub CancelTrace()
    m_bAbort = True
End Sub