ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/winhost/nettest.frm
Revision: 1.13
Committed: Fri Feb 23 13:23:53 2001 UTC (23 years, 8 months ago) by pjm2
Branch: MAIN
Changes since 1.12: +36 -27 lines
Log Message:
Number os seconds since the epoch are now included in the packets.

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 pjm2 1.11 Object = "{33155A3D-0CE0-11D1-A6B4-444553540000}#1.0#0"; "SysTray.ocx"
4 pjm2 1.1 Begin VB.Form Form1
5 pjm2 1.10 BorderStyle = 4 'Fixed ToolWindow
6     Caption = "i-scream Winhost"
7 pjm2 1.1 ClientHeight = 5655
8     ClientLeft = 45
9 pjm2 1.10 ClientTop = 285
10 pjm2 1.12 ClientWidth = 4710
11 pjm2 1.1 LinkTopic = "Form1"
12     MaxButton = 0 'False
13     ScaleHeight = 5655
14 pjm2 1.12 ScaleWidth = 4710
15 pjm2 1.1 ShowInTaskbar = 0 'False
16     StartUpPosition = 3 'Windows Default
17 pjm2 1.11 Begin VB.CommandButton Hide
18 pjm2 1.12 Caption = "Hide Window"
19     Height = 375
20     Left = 3120
21 pjm2 1.11 TabIndex = 7
22 pjm2 1.12 Top = 840
23     Width = 1455
24 pjm2 1.11 End
25     Begin SysTray.SystemTray SystemTray
26 pjm2 1.12 Left = 2160
27     Top = 1800
28 pjm2 1.11 _ExtentX = 847
29     _ExtentY = 847
30     SysTrayText = "i-scream Winhost"
31     IconFile = 0
32     End
33 pjm2 1.8 Begin VB.Timer Timer1
34 pjm2 1.12 Left = 2760
35     Top = 1800
36 pjm2 1.1 End
37     Begin VB.TextBox Text4
38 pjm2 1.6 Height = 1575
39 pjm2 1.1 Left = 240
40     MultiLine = -1 'True
41     ScrollBars = 2 'Vertical
42 pjm2 1.10 TabIndex = 1
43 pjm2 1.1 Text = "nettest.frx":0000
44     Top = 3000
45 pjm2 1.12 Width = 3975
46 pjm2 1.1 End
47 pjm2 1.10 Begin VB.CommandButton Reconfigure
48     Caption = "Reconfigure with FilterManager"
49 pjm2 1.12 Height = 375
50 pjm2 1.10 Left = 120
51     TabIndex = 0
52 pjm2 1.12 Top = 840
53 pjm2 1.10 Width = 2895
54 pjm2 1.1 End
55 pjm2 1.5 Begin MSWinsockLib.Winsock TCPSock
56 pjm2 1.12 Left = 3720
57     Top = 1800
58 pjm2 1.1 _ExtentX = 741
59     _ExtentY = 741
60     _Version = 393216
61     End
62 pjm2 1.5 Begin MSWinsockLib.Winsock UDPSock
63 pjm2 1.12 Left = 3240
64     Top = 1800
65 pjm2 1.1 _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.12 Left = 2400
75 pjm2 1.10 TabIndex = 6
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.12 Left = 2400
84 pjm2 1.10 TabIndex = 5
85 pjm2 1.9 Top = 120
86     Width = 1455
87 pjm2 1.8 End
88 pjm2 1.9 Begin VB.Label Label4
89 pjm2 1.10 BorderStyle = 1 'Fixed Single
90 pjm2 1.9 Caption = "0"
91 pjm2 1.7 Height = 255
92 pjm2 1.12 Left = 3960
93 pjm2 1.10 TabIndex = 4
94 pjm2 1.9 Top = 480
95     Width = 615
96 pjm2 1.7 End
97 pjm2 1.9 Begin VB.Label Label3
98 pjm2 1.10 BorderStyle = 1 'Fixed Single
99 pjm2 1.9 Caption = "0"
100 pjm2 1.7 Height = 255
101 pjm2 1.12 Left = 3960
102 pjm2 1.10 TabIndex = 3
103 pjm2 1.9 Top = 120
104     Width = 615
105 pjm2 1.7 End
106 pjm2 1.6 Begin VB.Label Status
107 pjm2 1.12 Alignment = 2 'Center
108 pjm2 1.6 Caption = "Status:"
109 pjm2 1.1 Height = 255
110 pjm2 1.6 Left = 120
111 pjm2 1.10 TabIndex = 2
112 pjm2 1.12 Top = 1320
113     Width = 4455
114 pjm2 1.1 End
115     End
116     Attribute VB_Name = "Form1"
117     Attribute VB_GlobalNameSpace = False
118     Attribute VB_Creatable = False
119     Attribute VB_PredeclaredId = True
120     Attribute VB_Exposed = False
121 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
122     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
123    
124     Dim filterManagerHostname As String
125     Dim filterManagerTCPPort As Integer
126    
127 pjm2 1.13 Dim seqNo As Long
128     Dim machineName As String
129    
130 pjm2 1.2 Dim filterHostname As String
131 pjm2 1.3 Dim filterTCPPort As Integer
132     Dim filterUDPPort As Integer
133     Dim fileList As String
134     Dim lastModified As String
135 pjm2 1.2
136 pjm2 1.7 Dim UDPUpdateTime As Integer
137     Dim TCPUpdateTime As Integer
138    
139 pjm2 1.2 Dim protocolVersion As String
140     Dim connected As Boolean
141 pjm2 1.1 Dim responseNumber As Integer
142    
143 pjm2 1.2 Private Sub Form_Load()
144 pjm2 1.13 x = MsgBox(Date2Num())
145    
146 pjm2 1.2 protocolVersion = "1.1"
147 pjm2 1.13
148 pjm2 1.10 Status.Caption = "Loading"
149     Form1.Caption = "i-scream Winhost " & protocolVersion
150 pjm2 1.6
151 pjm2 1.4 ''''TEMP
152     filterManagerHostname = "killigrew.ukc.ac.uk"
153     filterManagerTCPPort = 4567
154 pjm2 1.13 ''''' END TEMP
155 pjm2 1.4
156 pjm2 1.13 GoTo skip
157 pjm2 1.4 On Error GoTo iniError
158     Dim buf As String * 256
159     Dim length As Long
160     length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
161     filterManagerHostname = Left$(buf, length)
162     length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
163     filterManagerTCPPort = Left$(buf, length)
164 pjm2 1.13 skip:
165    
166 pjm2 1.10 Status.Caption = "Connecting to Filter Manager"
167 pjm2 1.13 Reconfigure_Click
168 pjm2 1.6
169 pjm2 1.4 Exit Sub
170    
171     iniError:
172     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")
173     End
174    
175     End Sub
176    
177 pjm2 1.10 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
178 pjm2 1.11 x = MsgBox("Are you sure you want to shut down the Winhost? This will stop your computer sending information to the i-scream Central Monitoring System.", vbYesNo, "i-scream Winhost")
179 pjm2 1.10 If x = 7 Then
180     Cancel = True
181     End If
182 pjm2 1.12 SystemTray.Action = 2
183 pjm2 1.10
184     End Sub
185    
186 pjm2 1.11 Private Sub Hide_Click()
187     Form1.Visible = False
188     SystemTray.Icon = Val(Form1.Icon)
189     SystemTray.Action = 0
190     End Sub
191    
192 pjm2 1.10 Private Sub Reconfigure_Click()
193     ' establish a TCP connection to a filtermanager
194     connected = False
195     TCPSock.Close
196     TCPSock.Connect filterManagerHostname, filterManagerTCPPort
197 pjm2 1.11 End Sub
198    
199    
200    
201     Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
202    
203     Form1.Visible = True
204 pjm2 1.12 SystemTray.Action = 2
205 pjm2 1.11 Form1.SetFocus
206 pjm2 1.12
207 pjm2 1.11
208 pjm2 1.10 End Sub
209    
210 pjm2 1.5 Private Sub TCPSock_Connect()
211 pjm2 1.6
212     responseNumber = 0
213 pjm2 1.1
214 pjm2 1.3 ' Send something as soon as we connect to the server.
215     If connected = False Then
216     ' contact the FilterManager
217 pjm2 1.5 TCPSock.SendData "STARTCONFIG" & vbCrLf
218 pjm2 1.3 Else
219     ' Contact the Filter
220 pjm2 1.5 TCPSock.SendData "HEARTBEAT" & vbCrLf
221 pjm2 1.3 End If
222 pjm2 1.1
223     End Sub
224    
225 pjm2 1.5 Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
226 pjm2 1.1
227     responseNumber = responseNumber + 1
228    
229     ' Get the line from the server.
230 pjm2 1.5 TCPSock.GetData response, vbString, bytesTotal
231 pjm2 1.1
232     ' Remove linefeeds and returns from the line.
233     response = Replace(response, Chr(13), "")
234     response = Replace(response, Chr(10), "")
235     Text4.Text = Text4.Text & vbCrLf & response
236    
237 pjm2 1.2 If connected = False Then
238     ' Perform TCP configuration (1.1)
239     On Error GoTo configError
240     Select Case responseNumber
241     Case 1:
242     If Not response = "OK" Then GoTo configError
243 pjm2 1.5 TCPSock.SendData "LASTMODIFIED" & vbCrLf
244 pjm2 1.2 Case 2:
245     If response = "ERROR" Then GoTo configError
246 pjm2 1.3 lastModified = response
247 pjm2 1.5 TCPSock.SendData "FILELIST" & vbCrLf
248 pjm2 1.2 Case 3:
249     If response = "ERROR" Then GoTo configError
250 pjm2 1.3 fileList = response
251 pjm2 1.5 TCPSock.SendData "UDPUpdateTime" & vbCrLf
252 pjm2 1.2 Case 4:
253     If response = "ERROR" Then GoTo configError
254 pjm2 1.7 UDPUpdateTime = response
255 pjm2 1.5 TCPSock.SendData "TCPUpdateTime" & vbCrLf
256 pjm2 1.2 Case 5:
257     If response = "ERROR" Then GoTo configError
258 pjm2 1.7 TCPUpdateTime = response
259 pjm2 1.5 TCPSock.SendData "ENDCONFIG" & vbCrLf
260 pjm2 1.2 Case 6:
261     If Not response = "OK" Then GoTo configError
262 pjm2 1.5 TCPSock.SendData "FILTER" & vbCrLf
263 pjm2 1.2 Case 7:
264     'we got a filter list here.
265     readTo = 0
266     ' get hostname
267     readTo = InStr(1, response, ";", vbBinaryCompare)
268     filterHostname = Mid(response, 1, readTo - 1)
269     response = Mid(response, readTo + 1, Len(response))
270     ' get UDP Port number
271     readTo = InStr(1, response, ";")
272     filterUDPPort = Mid(response, 1, readTo - 1)
273     response = Mid(response, readTo + 1, Len(response))
274     ' get TCP Port number
275     filterTCPPort = response
276 pjm2 1.5 TCPSock.SendData "END" & vbCrLf
277 pjm2 1.2 Case 8:
278     If Not response = "OK" Then GoTo configError
279     connected = True
280     responseNumber = 0
281 pjm2 1.5 TCPSock.Close
282 pjm2 1.2 Text4.Text = Text4.Text & vbCrLf & " <closed>"
283 pjm2 1.10 Status.Caption = "Configuration successful"
284 pjm2 1.8 Label3.Caption = UDPUpdateTime
285     Label4.Caption = TCPUpdateTime
286     Timer1.Interval = 1000
287 pjm2 1.2 End Select
288     Else
289     ' Perform a heartbeat (1.1)
290     On Error GoTo heartbeatError
291     Select Case responseNumber
292     Case 1:
293 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
294 pjm2 1.5 TCPSock.SendData "CONFIG" & vbCrLf
295 pjm2 1.2 Case 2:
296 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
297 pjm2 1.5 TCPSock.SendData fileList & vbCrLf
298 pjm2 1.2 Case 3:
299 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
300 pjm2 1.5 TCPSock.SendData lastModified & vbCrLf
301 pjm2 1.2 Case 4:
302 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
303 pjm2 1.5 TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
304 pjm2 1.2 Case 5:
305 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
306 pjm2 1.5 TCPSock.Close
307 pjm2 1.10 Status.Caption = "Heartbeat sent successfully."
308 pjm2 1.2 End Select
309    
310     End If
311    
312    
313     Exit Sub
314    
315     configError:
316 pjm2 1.10 Status.Caption = "FAILED to get configuration"
317 pjm2 1.8 Exit Sub
318 pjm2 1.2 heartbeatError:
319 pjm2 1.10 Status.Caption = "Heatbeat FAILED"
320 pjm2 1.8 Exit Sub
321 pjm2 1.1 End Sub
322 pjm2 1.5
323 pjm2 1.8 Private Sub Timer1_Timer()
324    
325     Label3.Caption = Label3.Caption - 1
326     Label4.Caption = Label4.Caption - 1
327    
328 pjm2 1.10 Status.Caption = ""
329 pjm2 1.8
330     If Label3.Caption < 1 Then
331     ' build the contents of the XML packet.
332 pjm2 1.13 localIP = TCPSock.localIP
333     machineName = TCPSock.LocalHostName
334     seqNo = seqNo + 1
335     packetDate = Now()
336     xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
337     "" & _
338     "" & _
339     "" & _
340     "" & _
341     "" & _
342     "" & _
343     "" & _
344     "" & _
345     "" & _
346     "" & _
347     "" & _
348     "" & _
349     "" & _
350     "" & _
351     ""
352     Text4.Text = Text4.Text + xml
353 pjm2 1.8
354     ' Use the first winsock control to send a UDP packet.
355     UDPSock.RemoteHost = filterHostname
356     UDPSock.RemotePort = filterUDPPort
357     UDPSock.SendData xml
358 pjm2 1.10 Status.Caption = "UDP packet sent"
359 pjm2 1.8 Label3.Caption = UDPUpdateTime
360     End If
361    
362     If Label4.Caption < 1 Then
363     ' establish a TCP connection to a filter
364     TCPSock.Close
365     TCPSock.Connect filterHostname, filterTCPPort
366     Label4.Caption = TCPUpdateTime
367     End If
368    
369     End Sub
370 pjm2 1.13
371     Function Date2Num() As Long
372     Date2Num = DateDiff("s", "1-1-1970", Now)
373     End Function