host/vb_net_test/nettest.frm

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TCP/UDP Test program"
   ClientHeight    =   5655
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5655
   ScaleWidth      =   5670
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command3 
      Caption         =   "TCP to Filter"
      Height          =   375
      Left            =   3720
      TabIndex        =   3
      Top             =   2520
      Width           =   1575
   End
   Begin VB.TextBox Text4 
      Height          =   1575
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Text            =   "nettest.frx":0000
      Top             =   3000
      Width           =   5055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "TCP to FilterManager"
      Height          =   375
      Left            =   3360
      TabIndex        =   1
      Top             =   2040
      Width           =   1935
   End
   Begin MSWinsockLib.Winsock TCPSock 
      Left            =   4920
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Send UDP"
      Height          =   375
      Left            =   4320
      TabIndex        =   0
      Top             =   1560
      Width           =   975
   End
   Begin MSWinsockLib.Winsock UDPSock 
      Left            =   4320
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.Label Status 
      Caption         =   "Status:"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   5280
      Width           =   5415
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long

Dim filterManagerHostname As String
Dim filterManagerTCPPort As Integer

Dim filterHostname As String
Dim filterTCPPort As Integer
Dim filterUDPPort As Integer
Dim fileList As String
Dim lastModified As String

Dim protocolVersion As String
Dim connected As Boolean
Dim responseNumber As Integer


Private Sub Command1_Click()

    ' build the contents of the XML packet.
    xml = "<packet></packet>"

    ' Use the first winsock control to send a UDP packet.
    UDPSock.RemoteHost = filterHostname
    UDPSock.RemotePort = filterUDPPort
    UDPSock.SendData xml
    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."

End Sub

Private Sub Command2_Click()
    
    ' establish a TCP connection to a filtermanager
    TCPSock.Close
    TCPSock.Connect filterManagerHostname, filterManagerTCPPort

End Sub

Private Sub Command3_Click()
    ' establish a TCP connection to a filter
    TCPSock.Close
    TCPSock.Connect filterHostname, filterTCPPort
End Sub

Private Sub Form_Load()
    protocolVersion = "1.1"
    
    Status.Caption = "i-scream Winhost " & protocolVersion
    
    ''''TEMP
    filterManagerHostname = "killigrew.ukc.ac.uk"
    filterManagerTCPPort = 4567
    Exit Sub
    ''' ENDTEMP
    
    On Error GoTo iniError
    Dim buf As String * 256
    Dim length As Long
    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
    filterManagerHostname = Left$(buf, length)
    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
    filterManagerTCPPort = Left$(buf, length)
    
    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
    
    Exit Sub
    
iniError:
    x = MsgBox("The i-scream Winhost could not read the correct settings from the winhost.ini file.  Please correct these and try again.", 48, "Configuration not found")
    End
    
End Sub

Private Sub Label1_Click()

End Sub

Private Sub TCPSock_Connect()
    
    responseNumber = 0
   
    ' Send something as soon as we connect to the server.
    If connected = False Then
        ' contact the FilterManager
        TCPSock.SendData "STARTCONFIG" & vbCrLf
    Else
       ' Contact the Filter
       TCPSock.SendData "HEARTBEAT" & vbCrLf
    End If
   
End Sub

Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
    
    responseNumber = responseNumber + 1
    
    ' Get the line from the server.
    TCPSock.GetData response, vbString, bytesTotal
    
    ' Remove linefeeds and returns from the line.
    response = Replace(response, Chr(13), "")
    response = Replace(response, Chr(10), "")
    Text4.Text = Text4.Text & vbCrLf & response
    
    If connected = False Then
        ' Perform TCP configuration (1.1)
        On Error GoTo configError
        Select Case responseNumber
            Case 1:
                If Not response = "OK" Then GoTo configError
                TCPSock.SendData "LASTMODIFIED" & vbCrLf
            Case 2:
                If response = "ERROR" Then GoTo configError
                lastModified = response
                TCPSock.SendData "FILELIST" & vbCrLf
            Case 3:
                If response = "ERROR" Then GoTo configError
                fileList = response
                TCPSock.SendData "UDPUpdateTime" & vbCrLf
            Case 4:
                If response = "ERROR" Then GoTo configError
                TCPSock.SendData "TCPUpdateTime" & vbCrLf
            Case 5:
                If response = "ERROR" Then GoTo configError
                TCPSock.SendData "ENDCONFIG" & vbCrLf
            Case 6:
                If Not response = "OK" Then GoTo configError
                TCPSock.SendData "FILTER" & vbCrLf
            Case 7:
                'we got a filter list here.
                readTo = 0
                ' get hostname
                readTo = InStr(1, response, ";", vbBinaryCompare)
                filterHostname = Mid(response, 1, readTo - 1)
                response = Mid(response, readTo + 1, Len(response))
                ' get UDP Port number
                readTo = InStr(1, response, ";")
                filterUDPPort = Mid(response, 1, readTo - 1)
                response = Mid(response, readTo + 1, Len(response))
                ' get TCP Port number
                filterTCPPort = response
                TCPSock.SendData "END" & vbCrLf
            Case 8:
                If Not response = "OK" Then GoTo configError
                connected = True
                responseNumber = 0
                TCPSock.Close
                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
                Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
        End Select
    Else
        ' Perform a heartbeat (1.1)
        On Error GoTo heartbeatError
        Select Case responseNumber
            Case 1:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData "CONFIG" & vbCrLf
            Case 2:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData fileList & vbCrLf
            Case 3:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData lastModified & vbCrLf
            Case 4:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
            Case 5:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.Close
                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
        End Select
    
    End If
    
    
    Exit Sub
    
configError:
    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration"
heartbeatError:
    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED"
End Sub

Revision:	1.6
Committed:	Fri Feb 23 10:53:30 2001 UTC (23 years, 9 months ago) by pjm2
Branch:	MAIN
Changes since 1.5:	+26 -25 lines
Log Message:	A label on the form now keeps onlookers up to date with what's going on.
#	User	Rev	Content
1	pjm2	1.1	VERSION 5.00
2			Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
3			Begin VB.Form Form1
4			BorderStyle = 3 'Fixed Dialog
5			Caption = "TCP/UDP Test program"
6			ClientHeight = 5655
7			ClientLeft = 45
8			ClientTop = 330
9			ClientWidth = 5670
10			LinkTopic = "Form1"
11			MaxButton = 0 'False
12			MinButton = 0 'False
13			ScaleHeight = 5655
14			ScaleWidth = 5670
15			ShowInTaskbar = 0 'False
16			StartUpPosition = 3 'Windows Default
17			Begin VB.CommandButton Command3
18			Caption = "TCP to Filter"
19			Height = 375
20			Left = 3720
21	pjm2	1.6	TabIndex = 3
22	pjm2	1.1	Top = 2520
23			Width = 1575
24			End
25			Begin VB.TextBox Text4
26	pjm2	1.6	Height = 1575
27	pjm2	1.1	Left = 240
28			MultiLine = -1 'True
29			ScrollBars = 2 'Vertical
30	pjm2	1.6	TabIndex = 2
31	pjm2	1.1	Text = "nettest.frx":0000
32			Top = 3000
33			Width = 5055
34			End
35			Begin VB.CommandButton Command2
36			Caption = "TCP to FilterManager"
37			Height = 375
38			Left = 3360
39	pjm2	1.6	TabIndex = 1
40	pjm2	1.1	Top = 2040
41			Width = 1935
42			End
43	pjm2	1.5	Begin MSWinsockLib.Winsock TCPSock
44	pjm2	1.1	Left = 4920
45			Top = 120
46			_ExtentX = 741
47			_ExtentY = 741
48			_Version = 393216
49			End
50			Begin VB.CommandButton Command1
51			Caption = "Send UDP"
52			Height = 375
53			Left = 4320
54	pjm2	1.6	TabIndex = 0
55	pjm2	1.1	Top = 1560
56			Width = 975
57			End
58	pjm2	1.5	Begin MSWinsockLib.Winsock UDPSock
59	pjm2	1.1	Left = 4320
60			Top = 120
61			_ExtentX = 741
62			_ExtentY = 741
63			_Version = 393216
64			Protocol = 1
65			End
66	pjm2	1.6	Begin VB.Label Status
67			Caption = "Status:"
68	pjm2	1.1	Height = 255
69	pjm2	1.6	Left = 120
70			TabIndex = 4
71			Top = 5280
72			Width = 5415
73	pjm2	1.1	End
74			End
75			Attribute VB_Name = "Form1"
76			Attribute VB_GlobalNameSpace = False
77			Attribute VB_Creatable = False
78			Attribute VB_PredeclaredId = True
79			Attribute VB_Exposed = False
80	pjm2	1.4	Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
81			Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
82
83			Dim filterManagerHostname As String
84			Dim filterManagerTCPPort As Integer
85
86	pjm2	1.2	Dim filterHostname As String
87	pjm2	1.3	Dim filterTCPPort As Integer
88			Dim filterUDPPort As Integer
89			Dim fileList As String
90			Dim lastModified As String
91	pjm2	1.2
92			Dim protocolVersion As String
93			Dim connected As Boolean
94	pjm2	1.1	Dim responseNumber As Integer
95
96
97			Private Sub Command1_Click()
98
99	pjm2	1.5	' build the contents of the XML packet.
100	pjm2	1.4	xml = "<packet></packet>"
101
102	pjm2	1.2	' Use the first winsock control to send a UDP packet.
103	pjm2	1.5	UDPSock.RemoteHost = filterHostname
104			UDPSock.RemotePort = filterUDPPort
105			UDPSock.SendData xml
106	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
107	pjm2	1.1
108			End Sub
109
110			Private Sub Command2_Click()
111
112	pjm2	1.3	' establish a TCP connection to a filtermanager
113	pjm2	1.5	TCPSock.Close
114			TCPSock.Connect filterManagerHostname, filterManagerTCPPort
115	pjm2	1.1
116			End Sub
117
118			Private Sub Command3_Click()
119	pjm2	1.3	' establish a TCP connection to a filter
120	pjm2	1.5	TCPSock.Close
121			TCPSock.Connect filterHostname, filterTCPPort
122	pjm2	1.1	End Sub
123
124	pjm2	1.2	Private Sub Form_Load()
125			protocolVersion = "1.1"
126	pjm2	1.4
127	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion
128
129	pjm2	1.4	''''TEMP
130			filterManagerHostname = "killigrew.ukc.ac.uk"
131			filterManagerTCPPort = 4567
132			Exit Sub
133			''' ENDTEMP
134
135			On Error GoTo iniError
136			Dim buf As String * 256
137			Dim length As Long
138			length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
139			filterManagerHostname = Left$(buf, length)
140			length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
141			filterManagerTCPPort = Left$(buf, length)
142
143	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
144
145	pjm2	1.4	Exit Sub
146
147			iniError:
148			x = MsgBox("The i-scream Winhost could not read the correct settings from the winhost.ini file. Please correct these and try again.", 48, "Configuration not found")
149			End
150
151			End Sub
152
153	pjm2	1.6	Private Sub Label1_Click()
154
155			End Sub
156
157	pjm2	1.5	Private Sub TCPSock_Connect()
158	pjm2	1.6
159			responseNumber = 0
160	pjm2	1.1
161	pjm2	1.3	' Send something as soon as we connect to the server.
162			If connected = False Then
163			' contact the FilterManager
164	pjm2	1.5	TCPSock.SendData "STARTCONFIG" & vbCrLf
165	pjm2	1.3	Else
166			' Contact the Filter
167	pjm2	1.5	TCPSock.SendData "HEARTBEAT" & vbCrLf
168	pjm2	1.3	End If
169	pjm2	1.1
170			End Sub
171
172	pjm2	1.5	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
173	pjm2	1.1
174			responseNumber = responseNumber + 1
175
176			' Get the line from the server.
177	pjm2	1.5	TCPSock.GetData response, vbString, bytesTotal
178	pjm2	1.1
179			' Remove linefeeds and returns from the line.
180			response = Replace(response, Chr(13), "")
181			response = Replace(response, Chr(10), "")
182			Text4.Text = Text4.Text & vbCrLf & response
183
184	pjm2	1.2	If connected = False Then
185			' Perform TCP configuration (1.1)
186			On Error GoTo configError
187			Select Case responseNumber
188			Case 1:
189			If Not response = "OK" Then GoTo configError
190	pjm2	1.5	TCPSock.SendData "LASTMODIFIED" & vbCrLf
191	pjm2	1.2	Case 2:
192			If response = "ERROR" Then GoTo configError
193	pjm2	1.3	lastModified = response
194	pjm2	1.5	TCPSock.SendData "FILELIST" & vbCrLf
195	pjm2	1.2	Case 3:
196			If response = "ERROR" Then GoTo configError
197	pjm2	1.3	fileList = response
198	pjm2	1.5	TCPSock.SendData "UDPUpdateTime" & vbCrLf
199	pjm2	1.2	Case 4:
200			If response = "ERROR" Then GoTo configError
201	pjm2	1.5	TCPSock.SendData "TCPUpdateTime" & vbCrLf
202	pjm2	1.2	Case 5:
203			If response = "ERROR" Then GoTo configError
204	pjm2	1.5	TCPSock.SendData "ENDCONFIG" & vbCrLf
205	pjm2	1.2	Case 6:
206			If Not response = "OK" Then GoTo configError
207	pjm2	1.5	TCPSock.SendData "FILTER" & vbCrLf
208	pjm2	1.2	Case 7:
209			'we got a filter list here.
210			readTo = 0
211			' get hostname
212			readTo = InStr(1, response, ";", vbBinaryCompare)
213			filterHostname = Mid(response, 1, readTo - 1)
214			response = Mid(response, readTo + 1, Len(response))
215			' get UDP Port number
216			readTo = InStr(1, response, ";")
217			filterUDPPort = Mid(response, 1, readTo - 1)
218			response = Mid(response, readTo + 1, Len(response))
219			' get TCP Port number
220			filterTCPPort = response
221	pjm2	1.5	TCPSock.SendData "END" & vbCrLf
222	pjm2	1.2	Case 8:
223			If Not response = "OK" Then GoTo configError
224			connected = True
225			responseNumber = 0
226	pjm2	1.5	TCPSock.Close
227	pjm2	1.2	Text4.Text = Text4.Text & vbCrLf & " <closed>"
228	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
229	pjm2	1.2	End Select
230			Else
231			' Perform a heartbeat (1.1)
232			On Error GoTo heartbeatError
233			Select Case responseNumber
234			Case 1:
235	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
236	pjm2	1.5	TCPSock.SendData "CONFIG" & vbCrLf
237	pjm2	1.2	Case 2:
238	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
239	pjm2	1.5	TCPSock.SendData fileList & vbCrLf
240	pjm2	1.2	Case 3:
241	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
242	pjm2	1.5	TCPSock.SendData lastModified & vbCrLf
243	pjm2	1.2	Case 4:
244	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
245	pjm2	1.5	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
246	pjm2	1.2	Case 5:
247	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
248	pjm2	1.5	TCPSock.Close
249	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
250	pjm2	1.2	End Select
251
252			End If
253
254
255			Exit Sub
256
257			configError:
258	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration"
259	pjm2	1.2	heartbeatError:
260	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED"
261	pjm2	1.1	End Sub
262	pjm2	1.5