ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/host/vb_net_test/nettest.frm
Revision: 1.14
Committed: Fri Feb 23 13:27:09 2001 UTC (23 years, 2 months ago) by pjm2
Branch: MAIN
Changes since 1.13: +4 -3 lines
Log Message:
Date is sent correctly formatted as seconds since 1-1-1970

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
145 pjm2 1.2 protocolVersion = "1.1"
146 pjm2 1.13
147 pjm2 1.10 Status.Caption = "Loading"
148     Form1.Caption = "i-scream Winhost " & protocolVersion
149 pjm2 1.6
150 pjm2 1.4 ''''TEMP
151     filterManagerHostname = "killigrew.ukc.ac.uk"
152     filterManagerTCPPort = 4567
153 pjm2 1.13 ''''' END TEMP
154 pjm2 1.4
155 pjm2 1.13 GoTo skip
156 pjm2 1.4 On Error GoTo iniError
157     Dim buf As String * 256
158     Dim length As Long
159     length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
160     filterManagerHostname = Left$(buf, length)
161     length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
162     filterManagerTCPPort = Left$(buf, length)
163 pjm2 1.13 skip:
164    
165 pjm2 1.10 Status.Caption = "Connecting to Filter Manager"
166 pjm2 1.13 Reconfigure_Click
167 pjm2 1.6
168 pjm2 1.4 Exit Sub
169    
170     iniError:
171     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")
172     End
173    
174     End Sub
175    
176 pjm2 1.10 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
177 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")
178 pjm2 1.10 If x = 7 Then
179     Cancel = True
180     End If
181 pjm2 1.12 SystemTray.Action = 2
182 pjm2 1.10
183     End Sub
184    
185 pjm2 1.11 Private Sub Hide_Click()
186     Form1.Visible = False
187     SystemTray.Icon = Val(Form1.Icon)
188     SystemTray.Action = 0
189     End Sub
190    
191 pjm2 1.10 Private Sub Reconfigure_Click()
192     ' establish a TCP connection to a filtermanager
193     connected = False
194     TCPSock.Close
195     TCPSock.Connect filterManagerHostname, filterManagerTCPPort
196 pjm2 1.11 End Sub
197    
198    
199    
200     Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
201    
202     Form1.Visible = True
203 pjm2 1.12 SystemTray.Action = 2
204 pjm2 1.11 Form1.SetFocus
205 pjm2 1.12
206 pjm2 1.11
207 pjm2 1.10 End Sub
208    
209 pjm2 1.5 Private Sub TCPSock_Connect()
210 pjm2 1.6
211     responseNumber = 0
212 pjm2 1.1
213 pjm2 1.3 ' Send something as soon as we connect to the server.
214     If connected = False Then
215     ' contact the FilterManager
216 pjm2 1.5 TCPSock.SendData "STARTCONFIG" & vbCrLf
217 pjm2 1.3 Else
218     ' Contact the Filter
219 pjm2 1.5 TCPSock.SendData "HEARTBEAT" & vbCrLf
220 pjm2 1.3 End If
221 pjm2 1.1
222     End Sub
223    
224 pjm2 1.5 Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
225 pjm2 1.1
226     responseNumber = responseNumber + 1
227    
228     ' Get the line from the server.
229 pjm2 1.5 TCPSock.GetData response, vbString, bytesTotal
230 pjm2 1.1
231     ' Remove linefeeds and returns from the line.
232     response = Replace(response, Chr(13), "")
233     response = Replace(response, Chr(10), "")
234     Text4.Text = Text4.Text & vbCrLf & response
235    
236 pjm2 1.2 If connected = False Then
237     ' Perform TCP configuration (1.1)
238     On Error GoTo configError
239     Select Case responseNumber
240     Case 1:
241     If Not response = "OK" Then GoTo configError
242 pjm2 1.5 TCPSock.SendData "LASTMODIFIED" & vbCrLf
243 pjm2 1.2 Case 2:
244     If response = "ERROR" Then GoTo configError
245 pjm2 1.3 lastModified = response
246 pjm2 1.5 TCPSock.SendData "FILELIST" & vbCrLf
247 pjm2 1.2 Case 3:
248     If response = "ERROR" Then GoTo configError
249 pjm2 1.3 fileList = response
250 pjm2 1.5 TCPSock.SendData "UDPUpdateTime" & vbCrLf
251 pjm2 1.2 Case 4:
252     If response = "ERROR" Then GoTo configError
253 pjm2 1.7 UDPUpdateTime = response
254 pjm2 1.5 TCPSock.SendData "TCPUpdateTime" & vbCrLf
255 pjm2 1.2 Case 5:
256     If response = "ERROR" Then GoTo configError
257 pjm2 1.7 TCPUpdateTime = response
258 pjm2 1.5 TCPSock.SendData "ENDCONFIG" & vbCrLf
259 pjm2 1.2 Case 6:
260     If Not response = "OK" Then GoTo configError
261 pjm2 1.5 TCPSock.SendData "FILTER" & vbCrLf
262 pjm2 1.2 Case 7:
263     'we got a filter list here.
264     readTo = 0
265     ' get hostname
266     readTo = InStr(1, response, ";", vbBinaryCompare)
267     filterHostname = Mid(response, 1, readTo - 1)
268     response = Mid(response, readTo + 1, Len(response))
269     ' get UDP Port number
270     readTo = InStr(1, response, ";")
271     filterUDPPort = Mid(response, 1, readTo - 1)
272     response = Mid(response, readTo + 1, Len(response))
273     ' get TCP Port number
274     filterTCPPort = response
275 pjm2 1.5 TCPSock.SendData "END" & vbCrLf
276 pjm2 1.2 Case 8:
277     If Not response = "OK" Then GoTo configError
278     connected = True
279     responseNumber = 0
280 pjm2 1.5 TCPSock.Close
281 pjm2 1.2 Text4.Text = Text4.Text & vbCrLf & " <closed>"
282 pjm2 1.10 Status.Caption = "Configuration successful"
283 pjm2 1.8 Label3.Caption = UDPUpdateTime
284     Label4.Caption = TCPUpdateTime
285     Timer1.Interval = 1000
286 pjm2 1.2 End Select
287     Else
288     ' Perform a heartbeat (1.1)
289     On Error GoTo heartbeatError
290     Select Case responseNumber
291     Case 1:
292 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
293 pjm2 1.5 TCPSock.SendData "CONFIG" & vbCrLf
294 pjm2 1.2 Case 2:
295 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
296 pjm2 1.5 TCPSock.SendData fileList & vbCrLf
297 pjm2 1.2 Case 3:
298 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
299 pjm2 1.5 TCPSock.SendData lastModified & vbCrLf
300 pjm2 1.2 Case 4:
301 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
302 pjm2 1.5 TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
303 pjm2 1.2 Case 5:
304 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
305 pjm2 1.5 TCPSock.Close
306 pjm2 1.10 Status.Caption = "Heartbeat sent successfully."
307 pjm2 1.2 End Select
308    
309     End If
310    
311    
312     Exit Sub
313    
314     configError:
315 pjm2 1.10 Status.Caption = "FAILED to get configuration"
316 pjm2 1.8 Exit Sub
317 pjm2 1.2 heartbeatError:
318 pjm2 1.10 Status.Caption = "Heatbeat FAILED"
319 pjm2 1.8 Exit Sub
320 pjm2 1.1 End Sub
321 pjm2 1.5
322 pjm2 1.8 Private Sub Timer1_Timer()
323    
324     Label3.Caption = Label3.Caption - 1
325     Label4.Caption = Label4.Caption - 1
326    
327 pjm2 1.10 Status.Caption = ""
328 pjm2 1.8
329     If Label3.Caption < 1 Then
330     ' build the contents of the XML packet.
331 pjm2 1.13 localIP = TCPSock.localIP
332     machineName = TCPSock.LocalHostName
333     seqNo = seqNo + 1
334 pjm2 1.14 packetDate = Date2Num()
335 pjm2 1.13 xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
336     "" & _
337     "" & _
338     "" & _
339     "" & _
340     "" & _
341     "" & _
342     "" & _
343     "" & _
344     "" & _
345     "" & _
346     "" & _
347     "" & _
348     "" & _
349     "" & _
350     ""
351     Text4.Text = Text4.Text + xml
352 pjm2 1.8
353     ' Use the first winsock control to send a UDP packet.
354     UDPSock.RemoteHost = filterHostname
355     UDPSock.RemotePort = filterUDPPort
356     UDPSock.SendData xml
357 pjm2 1.10 Status.Caption = "UDP packet sent"
358 pjm2 1.8 Label3.Caption = UDPUpdateTime
359     End If
360    
361     If Label4.Caption < 1 Then
362     ' establish a TCP connection to a filter
363     TCPSock.Close
364     TCPSock.Connect filterHostname, filterTCPPort
365     Label4.Caption = TCPUpdateTime
366     End If
367    
368     End Sub
369 pjm2 1.13
370     Function Date2Num() As Long
371 pjm2 1.14 Dim x As Long
372     x = DateDiff("s", "1-1-1970", Now)
373     Date2Num = x
374 pjm2 1.13 End Function