ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/host/vb_net_test/nettest.frm
Revision: 1.12
Committed: Fri Feb 23 12:01:14 2001 UTC (23 years, 8 months ago) by pjm2
Branch: MAIN
Changes since 1.11: +28 -24 lines
Log Message:
The system tray icon is now removed when the form is made visible or is
closed.

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