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
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "NsLookup"
ClientHeight = 5490
ClientLeft = 45
ClientTop = 330
ClientWidth = 7455
ClipControls = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5490
ScaleWidth = 7455
StartUpPosition = 1 'CenterOwner
Begin MSComctlLib.ImageList ImageList1
Left = 3120
Top = 3720
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 12
ImageHeight = 11
MaskColor = 16777215
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Main.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Main.frx":00EA
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Main.frx":01D4
Key = ""
EndProperty
EndProperty
End
Begin VB.TextBox txtPort
Height = 285
Left = 1320
TabIndex = 17
Top = 3960
Width = 975
End
Begin VB.TextBox txtTimeout
Height = 285
Left = 120
TabIndex = 15
Top = 3960
Width = 975
End
Begin MSComctlLib.ListView lvRecords
Height = 1815
Left = 120
TabIndex = 13
Top = 1800
Width = 7215
_ExtentX = 12726
_ExtentY = 3201
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
NumItems = 5
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Name"
Object.Width = 4207
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Type"
Object.Width = 1111
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Class"
Object.Width = 1111
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Data"
Object.Width = 5741
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 4
Text = "TTL"
Object.Width = 2857
EndProperty
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "Exit"
Height = 375
Left = 6120
TabIndex = 11
Top = 720
Width = 1215
End
Begin VB.CommandButton cmdQuery
Caption = "Query"
Default = -1 'True
Height = 375
Left = 6120
TabIndex = 10
Top = 240
Width = 1215
End
Begin VB.ComboBox cboClass
Height = 315
Left = 2760
TabIndex = 7
Top = 1080
Width = 3135
End
Begin VB.ComboBox cboServer
Height = 315
Left = 120
TabIndex = 6
Top = 1080
Width = 2415
End
Begin VB.ComboBox cboType
Height = 315
ItemData = "Main.frx":02BE
Left = 2760
List = "Main.frx":02C0
Sorted = -1 'True
TabIndex = 5
Top = 360
Width = 3135
End
Begin VB.ComboBox cboDomain
Height = 315
Left = 120
TabIndex = 4
Top = 360
Width = 2415
End
Begin VB.Label lblVersion
BackStyle = 0 'Transparent
Height = 255
Left = 840
TabIndex = 19
Top = 4680
Width = 5655
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "Returned records (double-click a record for details)"
Height = 255
Left = 120
TabIndex = 18
Top = 1560
Width = 3975
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "Server port"
Height = 255
Left = 1320
TabIndex = 16
Top = 3720
Width = 975
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "Timeout (ms)"
Height = 255
Left = 120
TabIndex = 14
Top = 3720
Width = 975
End
Begin VB.Label lblLicenseB
BackStyle = 0 'Transparent
Height = 255
Left = 840
TabIndex = 12
Top = 5160
Width = 5655
End
Begin VB.Label lblLicenseA
BackStyle = 0 'Transparent
Height = 255
Left = 840
TabIndex = 9
Top = 4920
Width = 5655
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "HexDns"
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
Left = 120
TabIndex = 8
Top = 4680
Width = 735
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 45
Left = 120
Top = 4440
Width = 7215
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "Query class"
Height = 255
Left = 2760
TabIndex = 3
Top = 840
Width = 975
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "Server"
Height = 255
Left = 120
TabIndex = 2
Top = 840
Width = 1215
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "Query type"
Height = 255
Left = 2760
TabIndex = 1
Top = 120
Width = 975
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Domain name"
Height = 255
Left = 120
TabIndex = 0
Top = 120
Width = 1215
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'// NsLookup sample program
'//
'// Demonstrates use of HexDns
'//
'// Copyright (C) 1999 Hexillion Technologies. All rights reserved.
'//
Option Explicit
Private m_oDns As HexDnsLib.Connection
Private m_oLkup As HexDnsLib.ILookupSync
Private m_oMsg As HexDnsLib.Message
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdQuery_Click()
lvRecords.ListItems.Clear
'// Validate input parameters
If 0 = Len(cboDomain.Text) Then
MsgBox "Please enter a domain"
cboDomain.SetFocus
Exit Sub
End If
Dim iType As Integer
If IsNumeric(cboType.Text) Then
iType = CInt(cboType.Text)
Else
iType = CInt(cboType.ItemData(cboType.ListIndex))
End If
If iType < 1 Or iType > 255 Then
MsgBox "Please enter a valid query type (1 to 255)"
cboType.SetFocus
Exit Sub
End If
Dim iClass As Integer
If IsNumeric(cboClass.Text) Then
iClass = CInt(cboClass.Text)
Else
iClass = CInt(cboClass.ItemData(cboClass.ListIndex))
End If
If iClass < 1 Or iClass > 255 Then
MsgBox "Please enter a valid query class (1 to 255)"
cboClass.SetFocus
Exit Sub
End If
'// Validate server address
'// m_oLkup has its own Connection and uses the default
'// server for domain lookups via LookUp
Dim lServerAddr As Long
lServerAddr = m_oLkup.LookUp(cboServer.Text)
If 0 = lServerAddr Then
MsgBox "Could not get an address for server '" & cboServer.Text & "'"
cboServer.SetFocus
Exit Sub
End If
Dim lTimeout As Long
If Not IsNumeric(txtTimeout) Then
MsgBox "Please enter a valid timeout period in milliseconds"
txtTimeout.SetFocus
Exit Sub
End If
lTimeout = CLng(txtTimeout)
Dim iPort As Integer
If Not IsNumeric(txtPort) Then
MsgBox "Please enter a valid port number"
txtPort.SetFocus
Exit Sub
End If
iPort = CInt(txtPort)
frmMain.MousePointer = vbHourglass
'// Do the query
m_oDns.RemoteAddr = lServerAddr
m_oDns.RemotePort = iPort
m_oDns.Timeout = lTimeout
Set m_oMsg = m_oDns.Query(cboDomain.Text, iType, iClass)
If hexDnsErrSuccess <> m_oDns.Error Then
MsgBox "Query failed: " & GetDnsErrorString(m_oDns.Error)
ElseIf hexDnsMsgRcodeSuccess <> m_oMsg.ResponseCode Then
MsgBox "DNS server returned an error: " & GetMsgRcodeString(m_oMsg.ResponseCode)
Else
Dim li As ListItem, oRec As Object, l As Long
For l = 1 To m_oMsg.AnswerRecords.Count
Set oRec = m_oMsg.AnswerRecords.Item(l)
Set li = lvRecords.ListItems.Add()
li.SmallIcon = 1
li.Text = oRec.Name
li.SubItems(1) = GetTypeStringShort(oRec.Type)
li.SubItems(2) = GetClassStringShort(oRec.Class)
li.SubItems(3) = GetRecordDataString(oRec)
li.SubItems(4) = GetTtlString(oRec.Ttl)
li.Key = "1 " & CStr(l)
Set li = Nothing
Next
For l = 1 To m_oMsg.AuthRecords.Count
Set oRec = m_oMsg.AuthRecords.Item(l)
Set li = lvRecords.ListItems.Add()
li.SmallIcon = 2
li.Text = oRec.Name
li.SubItems(1) = GetTypeStringShort(oRec.Type)
li.SubItems(2) = GetClassStringShort(oRec.Class)
li.SubItems(3) = GetRecordDataString(oRec)
li.SubItems(4) = GetTtlString(oRec.Ttl)
li.Key = "2 " & CStr(l)
Set li = Nothing
Next
For l = 1 To m_oMsg.AddtlRecords.Count
Set oRec = m_oMsg.AddtlRecords.Item(l)
Set li = lvRecords.ListItems.Add()
li.SmallIcon = 3
li.Text = oRec.Name
li.SubItems(1) = GetTypeStringShort(oRec.Type)
li.SubItems(2) = GetClassStringShort(oRec.Class)
li.SubItems(3) = GetRecordDataString(oRec)
li.SubItems(4) = GetTtlString(oRec.Ttl)
li.Key = "3 " & CStr(l)
Set li = Nothing
Next
End If
frmMain.MousePointer = vbDefault
End Sub
Private Sub Form_Initialize()
Set m_oDns = New HexDnsLib.Connection
Set m_oLkup = New HexDnsLib.LookUp
HexDnsInit
End Sub
Private Sub Form_Load()
'// Display version and license information
lblVersion = m_oDns.Version
If hexDnsErrSuccess <> m_oDns.Error Then
lblLicenseA = GetLicenseErrorString(m_oDns.Error)
lblLicenseB = "Evaluation expires " & m_oDns.Expires
ElseIf 0 = m_oDns.LicensedProcessors Then
lblLicenseA = "Runtime license"
lblLicenseB = ""
Else
lblLicenseA = GetLicenseType(m_oDns.LicensedProcessors) & " license"
lblLicenseB = m_oDns.LicensedUser
End If
'// Use defaults from component
txtTimeout = m_oDns.Timeout
txtPort = m_oDns.RemotePort
'// Fill domain combo
cboDomain.AddItem "yahoo.com"
cboDomain.AddItem "hexillion.com"
cboDomain.AddItem "kei.com"
cboDomain.AddItem "goldenglow.com.au"
cboDomain.AddItem "ns.ripe.net"
cboDomain.ListIndex = 0
'// Fill server combo
Dim v
For Each v In m_oDns.ServerAddrs
cboServer.AddItem m_oLkup.AddrToString(v)
Next
If cboServer.NewIndex >= 0 Then cboServer.ListIndex = 0
'// Fill type combo
Dim i As Integer
For i = 0 To 255
If Len(GetTypeStringShort(i)) Then
cboType.AddItem GetTypeStringShort(i) & " - " & GetTypeStringLong(i)
cboType.ItemData(cboType.NewIndex) = i
End If
Next
cboType.ListIndex = 0
'// Fill class combo
For i = 0 To 255
If Len(GetClassStringShort(i)) Then
cboClass.AddItem GetClassStringShort(i) & " - " & GetClassStringLong(i)
cboClass.ItemData(cboClass.NewIndex) = i
End If
Next
cboClass.ListIndex = 0
lvRecords.SmallIcons = ImageList1
End Sub
Private Sub Form_Terminate()
Set m_oLkup = Nothing
Set m_oMsg = Nothing
Set m_oDns = Nothing
End Sub
Private Sub lvRecords_DblClick()
Dim sKey As String, lGroup As Long, lIndex As Long
sKey = lvRecords.SelectedItem.Key
lGroup = CLng(Left$(sKey, 1))
lIndex = CLng(Right$(sKey, Len(sKey) - 2))
Dim frm As frmDetails
Set frm = New frmDetails
Select Case lGroup
Case 1
Set frm.m_oRec = m_oMsg.AnswerRecords.Item(lIndex)
Case 2
Set frm.m_oRec = m_oMsg.AuthRecords.Item(lIndex)
Case 3
Set frm.m_oRec = m_oMsg.AddtlRecords.Item(lIndex)
End Select
frm.Show vbModal, Me
Set frm = Nothing
End Sub