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