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