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.

VbTcpQuery.frm

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TcpQuery"
   ClientHeight    =   6930
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   8910
   ClipControls    =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6930
   ScaleWidth      =   8910
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtTimeout 
      Height          =   285
      Left            =   4920
      TabIndex        =   13
      Top             =   1080
      Width           =   1455
   End
   Begin VB.ComboBox cboServer 
      Height          =   315
      ItemData        =   "VbTcpQuery.frx":0000
      Left            =   120
      List            =   "VbTcpQuery.frx":0016
      TabIndex        =   12
      Text            =   "Combo1"
      Top             =   360
      Width           =   4455
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "Exit"
      Height          =   375
      Left            =   7800
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   960
      Width           =   975
   End
   Begin VB.CommandButton cmdGo 
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   375
      Left            =   6720
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   960
      Width           =   975
   End
   Begin VB.TextBox txtQuery 
      Height          =   285
      Left            =   120
      TabIndex        =   0
      Top             =   1080
      Width           =   4455
   End
   Begin VB.TextBox txtResponse 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4095
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   1800
      Width           =   8655
   End
   Begin VB.Frame Frame1 
      Caption         =   "Service"
      Height          =   615
      Left            =   4800
      TabIndex        =   7
      Top             =   120
      Width           =   3975
      Begin VB.OptionButton optService 
         Caption         =   "Whois"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   11
         Top             =   240
         Value           =   -1  'True
         Width           =   855
      End
      Begin VB.OptionButton optService 
         Caption         =   "Finger"
         Height          =   255
         Index           =   1
         Left            =   1200
         TabIndex        =   10
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton optService 
         Caption         =   "HTTP"
         Height          =   255
         Index           =   2
         Left            =   2160
         TabIndex        =   9
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton optService 
         Caption         =   "Echo"
         Height          =   255
         Index           =   3
         Left            =   3120
         TabIndex        =   8
         Top             =   240
         Width           =   735
      End
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "Timeout (ms)"
      Height          =   255
      Left            =   4920
      TabIndex        =   22
      Top             =   840
      Width           =   1335
   End
   Begin VB.Label lblLicenseB 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseB"
      Height          =   255
      Index           =   1
      Left            =   5400
      TabIndex        =   21
      Top             =   6600
      Width           =   2895
   End
   Begin VB.Label lblLicenseA 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseA"
      Height          =   255
      Index           =   1
      Left            =   5400
      TabIndex        =   20
      Top             =   6360
      Width           =   2895
   End
   Begin VB.Label lblVersion 
      BackStyle       =   0  'Transparent
      Caption         =   "version"
      Height          =   255
      Index           =   1
      Left            =   5400
      TabIndex        =   19
      Top             =   6120
      Width           =   2895
   End
   Begin VB.Label Label4 
      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        =   18
      Top             =   6120
      Width           =   1215
   End
   Begin VB.Label lblLicenseB 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseB"
      Height          =   255
      Index           =   0
      Left            =   1440
      TabIndex        =   17
      Top             =   6600
      Width           =   2655
   End
   Begin VB.Label lblLicenseA 
      BackStyle       =   0  'Transparent
      Caption         =   "licenseA"
      Height          =   255
      Index           =   0
      Left            =   1440
      TabIndex        =   16
      Top             =   6360
      Width           =   2655
   End
   Begin VB.Label lblVersion 
      BackStyle       =   0  'Transparent
      Caption         =   "version"
      Height          =   255
      Index           =   0
      Left            =   1440
      TabIndex        =   15
      Top             =   6120
      Width           =   2655
   End
   Begin VB.Label Label4 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "HexTcpQuery"
      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        =   14
      Top             =   6120
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "Server"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "Response"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   1560
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Query"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   840
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'// TcpQuery sample program
'//
'// Demonstrates use of HexTcpQuery and HexLookup
'// (but not necessarily good programming style :)
'//
'// Copyright (C) 1998 Hexillion Technologies. All rights reserved.
'//
Option Explicit
Private m_oTcpq As HexTcpQuery
Private m_oLkup As HexLookup
Private Const m_sUserAgent As String = "User-Agent: VbTcpQuery sample (http://www.hexillion.com)"

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdGo_Click()
    cmdGo.Enabled = False
    txtResponse = ""
    DoEvents
    
    'Look up remote server IP address, exit on failure
    Dim lAddr As Long
    lAddr = m_oLkup.LookUp(cboServer)
    If 0 = lAddr Then
        txtResponse = "Lookup of " & cboServer & " failed."
        cmdGo.Enabled = True
        Exit Sub
    End If
           
    m_oTcpq.Timeout = CLng(txtTimeout)
    Dim vStart
    vStart = Timer
           
    'Tell HexTcpQuery the server IP address
    m_oTcpq.RemoteAddr = lAddr
    
    'Set port and do query according to service selection
    If optService(0) Then
        m_oTcpq.RemotePort = hexTcpqPortWhois
        txtResponse = m_oTcpq.Query(txtQuery & vbCrLf)
        
    ElseIf optService(1) Then
        m_oTcpq.RemotePort = hexTcpqPortFinger
        txtResponse = m_oTcpq.Query(txtQuery & vbCrLf)
        
    ElseIf optService(2) Then
        m_oTcpq.RemotePort = hexTcpqPortHttp
        txtResponse = m_oTcpq.Query(txtQuery & vbCrLf & _
                                    m_sUserAgent & vbCrLf & _
                                    "Host: " & cboServer & vbCrLf & _
                                    vbCrLf)
        
    Else
        'The following block of code demonstrates QueryBinary.
        m_oTcpq.RemotePort = hexTcpqPortEcho
        
        'Convert query string to byte array
        Dim sQuery As String, sResponse As String
        Dim i As Integer, iQueryLen As Integer
        sQuery = txtQuery
        iQueryLen = Len(sQuery)
        ReDim byQuery(1 To iQueryLen) As Byte
        For i = 1 To iQueryLen
            byQuery(i) = Asc(Mid$(sQuery, i, 1))
        Next
        
        'Do the query
        'There are two query lines below: one that
        'passes the byte array to QueryBinary, one that
        'passes the string. You can use either one--
        'they both achieve the same result.
        Dim vResponse As Variant
        vResponse = m_oTcpq.QueryBinary(byQuery)
'        vResponse = m_oTcpq.QueryBinary(sQuery)

        'Convert the byte array response to characters
        For i = LBound(vResponse) To UBound(vResponse)
            txtResponse = txtResponse & Chr$(vResponse(i))
        Next
    End If
    
    'Interpret the value of the Error property
    Select Case m_oTcpq.Error
        Case hexTcpqErrSuccess
            'Do nothing
        Case hexTcpqErrConnectionRefused
            txtResponse = txtResponse & vbCrLf & "[Connection refused]"
        Case hexTcpqErrConnectionReset
            txtResponse = txtResponse & vbCrLf & "[Connection dropped by remote host]"
        Case hexTcpqErrHostUnreachable
            txtResponse = txtResponse & vbCrLf & "[Host unreachable]"
        Case hexTcpqErrNetworkUnreachable
            txtResponse = txtResponse & vbCrLf & "[Network unreachable]"
        Case hexTcpqErrTimedOut
            txtResponse = txtResponse & vbCrLf & "[Query timed out]"
        Case Else
            txtResponse = txtResponse & vbCrLf & "[Error " & m_oTcpq.Error & "]"
    End Select
    
    txtResponse = txtResponse & vbCrLf & "[Query time: " & (Timer - vStart) & "s]"
    
    cmdGo.Enabled = True
End Sub

Private Sub Form_Initialize()
    Set m_oTcpq = New HexTcpQuery
    Set m_oLkup = New HexLookup
End Sub

Private Sub Form_Load()
    '// Display version and license information
    lblVersion(0) = m_oTcpq.Version
    If hexTcpqErrSuccess <> m_oTcpq.Error Then
        lblLicenseA(0) = GetLicenseErrorString(m_oTcpq.Error)
        lblLicenseB(0) = "Evaluation expires " & m_oTcpq.Expires
        
    ElseIf 0 = m_oTcpq.LicensedProcessors Then
        lblLicenseA(0) = "Runtime license"
        lblLicenseB(0) = ""
        
    Else
        lblLicenseA(0) = GetLicenseType(m_oTcpq.LicensedProcessors) & " license"
        lblLicenseB(0) = m_oTcpq.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
    
    cboServer.ListIndex = 0
    txtQuery = "help"
    txtTimeout = m_oTcpq.Timeout
End Sub

Private Sub Form_Terminate()
    Set m_oTcpq = Nothing
    Set m_oLkup = Nothing
End Sub


Private Sub optService_Click(Index As Integer)
    If Index = 2 Then txtQuery = "GET / HTTP/1.0"
End Sub