ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/winhost/nettest.frm
Revision: 1.9
Committed: Fri Feb 23 11:30:25 2001 UTC (23 years, 9 months ago) by pjm2
Branch: MAIN
Changes since 1.8: +22 -22 lines
Log Message:
Times of next UDP packet and Heartbeat is displayed on the form.

File Contents

# 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 pjm2 1.8 Begin VB.Timer Timer1
18 pjm2 1.7 Left = 3840
19     Top = 120
20     End
21 pjm2 1.1 Begin VB.CommandButton Command3
22     Caption = "TCP to Filter"
23     Height = 375
24     Left = 3720
25 pjm2 1.6 TabIndex = 3
26 pjm2 1.1 Top = 2520
27     Width = 1575
28     End
29     Begin VB.TextBox Text4
30 pjm2 1.6 Height = 1575
31 pjm2 1.1 Left = 240
32     MultiLine = -1 'True
33     ScrollBars = 2 'Vertical
34 pjm2 1.6 TabIndex = 2
35 pjm2 1.1 Text = "nettest.frx":0000
36     Top = 3000
37     Width = 5055
38     End
39     Begin VB.CommandButton Command2
40     Caption = "TCP to FilterManager"
41     Height = 375
42     Left = 3360
43 pjm2 1.6 TabIndex = 1
44 pjm2 1.1 Top = 2040
45     Width = 1935
46     End
47 pjm2 1.5 Begin MSWinsockLib.Winsock TCPSock
48 pjm2 1.1 Left = 4920
49     Top = 120
50     _ExtentX = 741
51     _ExtentY = 741
52     _Version = 393216
53     End
54     Begin VB.CommandButton Command1
55     Caption = "Send UDP"
56     Height = 375
57     Left = 4320
58 pjm2 1.6 TabIndex = 0
59 pjm2 1.1 Top = 1560
60     Width = 975
61     End
62 pjm2 1.5 Begin MSWinsockLib.Winsock UDPSock
63 pjm2 1.1 Left = 4320
64     Top = 120
65     _ExtentX = 741
66     _ExtentY = 741
67     _Version = 393216
68     Protocol = 1
69     End
70 pjm2 1.9 Begin VB.Label Label2
71     Alignment = 1 'Right Justify
72     Caption = "Next heartbeat:"
73 pjm2 1.8 Height = 255
74 pjm2 1.9 Left = 120
75 pjm2 1.8 TabIndex = 8
76 pjm2 1.9 Top = 480
77     Width = 1455
78 pjm2 1.8 End
79 pjm2 1.9 Begin VB.Label Label1
80     Alignment = 1 'Right Justify
81     Caption = "Next UDP packet:"
82 pjm2 1.8 Height = 255
83 pjm2 1.9 Left = 120
84 pjm2 1.8 TabIndex = 7
85 pjm2 1.9 Top = 120
86     Width = 1455
87 pjm2 1.8 End
88 pjm2 1.9 Begin VB.Label Label4
89     Caption = "0"
90 pjm2 1.7 Height = 255
91 pjm2 1.9 Left = 1680
92 pjm2 1.7 TabIndex = 6
93 pjm2 1.9 Top = 480
94     Width = 615
95 pjm2 1.7 End
96 pjm2 1.9 Begin VB.Label Label3
97     Caption = "0"
98 pjm2 1.7 Height = 255
99 pjm2 1.9 Left = 1680
100 pjm2 1.7 TabIndex = 5
101 pjm2 1.9 Top = 120
102     Width = 615
103 pjm2 1.7 End
104 pjm2 1.6 Begin VB.Label Status
105     Caption = "Status:"
106 pjm2 1.1 Height = 255
107 pjm2 1.6 Left = 120
108     TabIndex = 4
109     Top = 5280
110     Width = 5415
111 pjm2 1.1 End
112     End
113     Attribute VB_Name = "Form1"
114     Attribute VB_GlobalNameSpace = False
115     Attribute VB_Creatable = False
116     Attribute VB_PredeclaredId = True
117     Attribute VB_Exposed = False
118 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
119     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
120    
121     Dim filterManagerHostname As String
122     Dim filterManagerTCPPort As Integer
123    
124 pjm2 1.2 Dim filterHostname As String
125 pjm2 1.3 Dim filterTCPPort As Integer
126     Dim filterUDPPort As Integer
127     Dim fileList As String
128     Dim lastModified As String
129 pjm2 1.2
130 pjm2 1.7 Dim UDPUpdateTime As Integer
131     Dim TCPUpdateTime As Integer
132    
133 pjm2 1.2 Dim protocolVersion As String
134     Dim connected As Boolean
135 pjm2 1.1 Dim responseNumber As Integer
136    
137    
138     Private Sub Command1_Click()
139    
140 pjm2 1.5 ' build the contents of the XML packet.
141 pjm2 1.4 xml = "<packet></packet>"
142    
143 pjm2 1.2 ' Use the first winsock control to send a UDP packet.
144 pjm2 1.5 UDPSock.RemoteHost = filterHostname
145     UDPSock.RemotePort = filterUDPPort
146     UDPSock.SendData xml
147 pjm2 1.6 Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
148 pjm2 1.1
149     End Sub
150    
151     Private Sub Command2_Click()
152    
153 pjm2 1.3 ' establish a TCP connection to a filtermanager
154 pjm2 1.5 TCPSock.Close
155     TCPSock.Connect filterManagerHostname, filterManagerTCPPort
156 pjm2 1.1
157     End Sub
158    
159     Private Sub Command3_Click()
160 pjm2 1.3 ' establish a TCP connection to a filter
161 pjm2 1.5 TCPSock.Close
162     TCPSock.Connect filterHostname, filterTCPPort
163 pjm2 1.1 End Sub
164    
165 pjm2 1.2 Private Sub Form_Load()
166     protocolVersion = "1.1"
167 pjm2 1.4
168 pjm2 1.6 Status.Caption = "i-scream Winhost " & protocolVersion
169    
170 pjm2 1.4 ''''TEMP
171     filterManagerHostname = "killigrew.ukc.ac.uk"
172     filterManagerTCPPort = 4567
173     Exit Sub
174     ''' ENDTEMP
175    
176     On Error GoTo iniError
177     Dim buf As String * 256
178     Dim length As Long
179     length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
180     filterManagerHostname = Left$(buf, length)
181     length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
182     filterManagerTCPPort = Left$(buf, length)
183    
184 pjm2 1.6 Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
185    
186 pjm2 1.4 Exit Sub
187    
188     iniError:
189     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")
190     End
191    
192     End Sub
193    
194 pjm2 1.5 Private Sub TCPSock_Connect()
195 pjm2 1.6
196     responseNumber = 0
197 pjm2 1.1
198 pjm2 1.3 ' Send something as soon as we connect to the server.
199     If connected = False Then
200     ' contact the FilterManager
201 pjm2 1.5 TCPSock.SendData "STARTCONFIG" & vbCrLf
202 pjm2 1.3 Else
203     ' Contact the Filter
204 pjm2 1.5 TCPSock.SendData "HEARTBEAT" & vbCrLf
205 pjm2 1.3 End If
206 pjm2 1.1
207     End Sub
208    
209 pjm2 1.5 Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
210 pjm2 1.1
211     responseNumber = responseNumber + 1
212    
213     ' Get the line from the server.
214 pjm2 1.5 TCPSock.GetData response, vbString, bytesTotal
215 pjm2 1.1
216     ' Remove linefeeds and returns from the line.
217     response = Replace(response, Chr(13), "")
218     response = Replace(response, Chr(10), "")
219     Text4.Text = Text4.Text & vbCrLf & response
220    
221 pjm2 1.2 If connected = False Then
222     ' Perform TCP configuration (1.1)
223     On Error GoTo configError
224     Select Case responseNumber
225     Case 1:
226     If Not response = "OK" Then GoTo configError
227 pjm2 1.5 TCPSock.SendData "LASTMODIFIED" & vbCrLf
228 pjm2 1.2 Case 2:
229     If response = "ERROR" Then GoTo configError
230 pjm2 1.3 lastModified = response
231 pjm2 1.5 TCPSock.SendData "FILELIST" & vbCrLf
232 pjm2 1.2 Case 3:
233     If response = "ERROR" Then GoTo configError
234 pjm2 1.3 fileList = response
235 pjm2 1.5 TCPSock.SendData "UDPUpdateTime" & vbCrLf
236 pjm2 1.2 Case 4:
237     If response = "ERROR" Then GoTo configError
238 pjm2 1.7 UDPUpdateTime = response
239 pjm2 1.5 TCPSock.SendData "TCPUpdateTime" & vbCrLf
240 pjm2 1.2 Case 5:
241     If response = "ERROR" Then GoTo configError
242 pjm2 1.7 TCPUpdateTime = response
243 pjm2 1.5 TCPSock.SendData "ENDCONFIG" & vbCrLf
244 pjm2 1.2 Case 6:
245     If Not response = "OK" Then GoTo configError
246 pjm2 1.5 TCPSock.SendData "FILTER" & vbCrLf
247 pjm2 1.2 Case 7:
248     'we got a filter list here.
249     readTo = 0
250     ' get hostname
251     readTo = InStr(1, response, ";", vbBinaryCompare)
252     filterHostname = Mid(response, 1, readTo - 1)
253     response = Mid(response, readTo + 1, Len(response))
254     ' get UDP Port number
255     readTo = InStr(1, response, ";")
256     filterUDPPort = Mid(response, 1, readTo - 1)
257     response = Mid(response, readTo + 1, Len(response))
258     ' get TCP Port number
259     filterTCPPort = response
260 pjm2 1.5 TCPSock.SendData "END" & vbCrLf
261 pjm2 1.2 Case 8:
262     If Not response = "OK" Then GoTo configError
263     connected = True
264     responseNumber = 0
265 pjm2 1.5 TCPSock.Close
266 pjm2 1.2 Text4.Text = Text4.Text & vbCrLf & " <closed>"
267 pjm2 1.6 Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
268 pjm2 1.8 Label3.Caption = UDPUpdateTime
269     Label4.Caption = TCPUpdateTime
270     Timer1.Interval = 1000
271 pjm2 1.2 End Select
272     Else
273     ' Perform a heartbeat (1.1)
274     On Error GoTo heartbeatError
275     Select Case responseNumber
276     Case 1:
277 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
278 pjm2 1.5 TCPSock.SendData "CONFIG" & vbCrLf
279 pjm2 1.2 Case 2:
280 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
281 pjm2 1.5 TCPSock.SendData fileList & vbCrLf
282 pjm2 1.2 Case 3:
283 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
284 pjm2 1.5 TCPSock.SendData lastModified & vbCrLf
285 pjm2 1.2 Case 4:
286 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
287 pjm2 1.5 TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
288 pjm2 1.2 Case 5:
289 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
290 pjm2 1.5 TCPSock.Close
291 pjm2 1.6 Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
292 pjm2 1.2 End Select
293    
294     End If
295    
296    
297     Exit Sub
298    
299     configError:
300 pjm2 1.8 Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
301     Exit Sub
302 pjm2 1.2 heartbeatError:
303 pjm2 1.8 Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
304     Exit Sub
305 pjm2 1.1 End Sub
306 pjm2 1.5
307 pjm2 1.8 Private Sub TCPTimer_Timer()
308    
309     ' establish a TCP connection to a filter
310     TCPSock.Close
311     TCPSock.Connect filterHostname, filterTCPPort
312    
313     End Sub
314    
315     Private Sub UDPTimer_Timer()
316    
317     ' build the contents of the XML packet.
318     xml = "<packet></packet>"
319    
320     ' Use the first winsock control to send a UDP packet.
321     UDPSock.RemoteHost = filterHostname
322     UDPSock.RemotePort = filterUDPPort
323     UDPSock.SendData xml
324     Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
325    
326     End Sub
327    
328     Private Sub Timer1_Timer()
329    
330     Label3.Caption = Label3.Caption - 1
331     Label4.Caption = Label4.Caption - 1
332    
333     Status.Caption = "i-scream Winhost " & protocolVersion
334    
335     If Label3.Caption < 1 Then
336     ' build the contents of the XML packet.
337     xml = "<packet></packet>"
338    
339     ' Use the first winsock control to send a UDP packet.
340     UDPSock.RemoteHost = filterHostname
341     UDPSock.RemotePort = filterUDPPort
342     UDPSock.SendData xml
343     Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
344     Label3.Caption = UDPUpdateTime
345     End If
346    
347     If Label4.Caption < 1 Then
348     ' establish a TCP connection to a filter
349     TCPSock.Close
350     TCPSock.Connect filterHostname, filterTCPPort
351     Label4.Caption = TCPUpdateTime
352     End If
353    
354     End Sub