ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/winhost/nettest.frm
Revision: 1.40
Committed: Fri Mar 28 16:30:35 2003 UTC (21 years, 8 months ago) by tdb
Branch: MAIN
CVS Tags: HEAD
Changes since 1.39: +0 -0 lines
State: FILE REMOVED
Log Message:
Removed some un-used code from CVS. We can always resurrect this later if
someone feels they want to work on it. Gone are the old perl ihost which
isn't needed now, winhost which is broken and shows no sign of being fixed,
and DBReporter. If someone wants to revive them, I'll undelete them :-)

File Contents

# Content
1 VERSION 5.00
2 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
3 Object = "{33155A3D-0CE0-11D1-A6B4-444553540000}#1.0#0"; "SysTray.ocx"
4 Begin VB.Form Form1
5 BorderStyle = 3 'Fixed Dialog
6 Caption = "i-scream Winhost"
7 ClientHeight = 1380
8 ClientLeft = 45
9 ClientTop = 330
10 ClientWidth = 4635
11 Icon = "nettest.frx":0000
12 LinkTopic = "Form1"
13 MaxButton = 0 'False
14 MinButton = 0 'False
15 ScaleHeight = 1380
16 ScaleWidth = 4635
17 ShowInTaskbar = 0 'False
18 StartUpPosition = 2 'CenterScreen
19 Visible = 0 'False
20 Begin VB.CommandButton Command1
21 Caption = "more"
22 Height = 255
23 Left = 3885
24 TabIndex = 8
25 Top = 1035
26 Width = 615
27 End
28 Begin VB.TextBox Text1
29 Height = 2055
30 Left = 120
31 Locked = -1 'True
32 MultiLine = -1 'True
33 ScrollBars = 2 'Vertical
34 TabIndex = 7
35 Top = 1440
36 Width = 4395
37 End
38 Begin VB.CommandButton Hide
39 Caption = "hide"
40 Height = 255
41 Left = 3225
42 TabIndex = 6
43 Top = 1035
44 Width = 615
45 End
46 Begin SysTray.SystemTray SystemTray
47 Left = 2520
48 Top = 4200
49 _ExtentX = 847
50 _ExtentY = 847
51 SysTrayText = "i-scream Winhost"
52 IconFile = 0
53 End
54 Begin VB.Timer Timer1
55 Left = 3120
56 Top = 4200
57 End
58 Begin VB.CommandButton Reconfigure
59 Caption = "Reconfigure with FilterManager"
60 Height = 375
61 Left = 840
62 TabIndex = 0
63 Top = 3555
64 Width = 2895
65 End
66 Begin MSWinsockLib.Winsock TCPSock
67 Left = 4080
68 Top = 4200
69 _ExtentX = 741
70 _ExtentY = 741
71 _Version = 393216
72 End
73 Begin MSWinsockLib.Winsock UDPSock
74 Left = 3600
75 Top = 4200
76 _ExtentX = 741
77 _ExtentY = 741
78 _Version = 393216
79 Protocol = 1
80 End
81 Begin VB.Image Image1
82 Height = 900
83 Left = 2400
84 Picture = "nettest.frx":08CA
85 Top = 90
86 Width = 2100
87 End
88 Begin VB.Label Label2
89 Alignment = 1 'Right Justify
90 Caption = "Next heartbeat:"
91 Height = 255
92 Left = 120
93 TabIndex = 5
94 Top = 645
95 Width = 1455
96 End
97 Begin VB.Label Label1
98 Alignment = 1 'Right Justify
99 Caption = "Next UDP packet:"
100 Height = 255
101 Left = 120
102 TabIndex = 4
103 Top = 165
104 Width = 1455
105 End
106 Begin VB.Label Label4
107 BorderStyle = 1 'Fixed Single
108 Caption = "0"
109 Height = 255
110 Left = 1680
111 TabIndex = 3
112 Top = 645
113 Width = 615
114 End
115 Begin VB.Label Label3
116 BorderStyle = 1 'Fixed Single
117 Caption = "0"
118 Height = 255
119 Left = 1680
120 TabIndex = 2
121 Top = 165
122 Width = 615
123 End
124 Begin VB.Label Status
125 Alignment = 2 'Center
126 Caption = "Status:"
127 Height = 255
128 Left = 0
129 TabIndex = 1
130 Top = 1035
131 Width = 3180
132 End
133 End
134 Attribute VB_Name = "Form1"
135 Attribute VB_GlobalNameSpace = False
136 Attribute VB_Creatable = False
137 Attribute VB_PredeclaredId = True
138 Attribute VB_Exposed = False
139 ' For the system tray methods
140 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
141 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
142
143 ' Address of the filter manager
144 Dim filterManagerHostname As String
145 Dim filterManagerTCPPort As Long
146
147 ' Sequence number and machine name are sent in each UDP packet.
148 Dim seqNo As Long
149 Dim machineName As String
150
151 ' DEPRICATED. The number of seconds that the program has been running.
152 Dim secondsRunning As Long
153
154 ' Address of the filter to use.
155 Dim filterHostname As String
156 Dim filterTCPPort As Integer
157 Dim filterUDPPort As Integer
158
159 ' Server configuration details.
160 Dim fileList As String
161 Dim lastModified As String
162
163 ' Time intervals between UDP packets and heartbeats.
164 Dim UDPUpdateTime As Integer
165 Dim TCPUpdateTime As Integer
166
167 ' The protocol version used by the winhost.
168 Dim protocolVersion As String
169
170 ' Action flags.
171 Dim connected As Boolean
172 Dim heartBeating As Boolean
173 Dim windowBig As Boolean
174
175 ' Define classes to be used to obtain uptime and number of users.
176 Dim CUpTime As New CUpTime
177 Dim wksta As New CNetWksta
178
179 ' Keep track of the line number in TCP communications.
180 Dim responseNumber As Integer
181
182
183 ' Toggle visibility of the debug output.
184 Private Sub Command1_Click()
185 If windowBig Then
186 Form1.Height = 1755
187 windowBig = False
188 Else
189 Form1.Height = 4380
190 windowBig = True
191 End If
192 End Sub
193
194
195 ' Main method (or its Visual Basic equivalent!).
196 Private Sub Form_Load()
197
198 ' Do not let any user run the program twice on one machine.
199 If App.PrevInstance Then
200 x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
201 End
202 End If
203
204 protocolVersion = "1.1"
205
206 Status.Caption = "Loading"
207 Form1.Caption = "i-scream Winhost " & protocolVersion
208
209 CUpTime.Init
210
211 ' Some class functions only work on NT-based systems, and Win9x boxes
212 ' are rarely used as servers, anyway.
213 If CUpTime.isWin9x Then
214 x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
215 End
216 End If
217
218 ' Start the program with the small window size.
219 windowBig = False
220
221 ' Catch errors while reading the configuration from the ini file.
222 On Error GoTo iniError
223
224 Dim buf As String * 256
225 Dim length As Long
226 length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "", buf, Len(buf), App.Path & "/winhost.ini")
227 filterManagerHostname = Left$(buf, length)
228 length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
229 filterManagerTCPPort = length
230
231 If filterManagerHostname = "" Then
232 GoTo iniError
233 End If
234
235 ' Resume normal error handling.
236 On Error GoTo 0
237
238 ' We have the configuration. Now connect.
239 Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
240 Reconfigure_Click
241
242 ' Install the icon in the system tray.
243 SystemTray.Icon = Val(Form1.Icon)
244 SystemTray.Action = 0
245
246
247 Exit Sub
248
249 ' Error handler
250 iniError:
251 x = MsgBox("The i-scream Winhost could not read the correct settings from the winhost.ini file. Please correct these and try again. " & Err.Description, 48, "Configuration not found")
252 End
253
254 End Sub
255
256
257 ' Unload event. Also fires when the machine is shutting down.
258 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
259
260 ' Prevent users from unwittingly shutting down thet winhost.
261 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")
262 If x = 7 Then
263 Cancel = True
264 Else
265 ' Remove the icon from the system tray.
266 SystemTray.Action = 2
267 End If
268
269 End Sub
270
271
272 ' Make the form disappear and update the icon in the system tray.
273 Private Sub Hide_Click()
274 Form1.Visible = False
275 SystemTray.Icon = Val(Form1.Icon)
276 End Sub
277
278
279 ' Reconfigure the host with the filter manager.
280 Private Sub Reconfigure_Click()
281 ' establish a TCP connection to a filtermanager, provided another TCP
282 ' communication is not already taking place.
283 If Not heartBeating Then
284 connected = False
285 TCPSock.Close
286 TCPSock.Connect filterManagerHostname, filterManagerTCPPort
287 Else
288 Status.Caption = "Cannot reconfigure while heartbeating"
289 End If
290 End Sub
291
292
293 ' Do this when the user double-clicks on the system tray icon.
294 Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
295 ' After double-clicking on the system tray icon, we make the
296 ' form visible and give it active focus.
297 Form1.Visible = True
298 Form1.SetFocus
299
300 End Sub
301
302
303 ' Establish a connection with the filter manager.
304 ' Thereafter, use the filter instead.
305 Private Sub TCPSock_Connect()
306
307 ' Start from the first line of the response.
308 responseNumber = 0
309
310 ' Send something as soon as we connect to the server.
311 If connected = False Then
312 ' contact the FilterManager
313 TCPSock.SendData "STARTCONFIG" & vbCrLf
314 Else
315 ' Contact the Filter
316 TCPSock.SendData "HEARTBEAT" & vbCrLf
317 End If
318
319 End Sub
320
321
322 ' Deal with TCP traffic coming from the filter or filter manager.
323 Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
324
325 ' Move to the next line of the response.
326 responseNumber = responseNumber + 1
327
328 ' Get the line from the server.
329 TCPSock.GetData response, vbString, bytesTotal
330
331 ' Remove linefeeds and returns from the line.
332 response = Replace(response, Chr(13), "")
333 response = Replace(response, Chr(10), "")
334
335 If connected = False Then
336 ' Perform TCP configuration (1.1)
337 On Error GoTo configError
338 Select Case responseNumber
339 Case 1:
340 If Not response = "OK" Then GoTo configError
341 TCPSock.SendData "LASTMODIFIED" & vbCrLf
342 Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
343 Text1.Text = Text1.Text & response & vbCrLf
344 Case 2:
345 If response = "ERROR" Then GoTo configError
346 lastModified = response
347 Text1.Text = Text1.Text & response & vbCrLf
348 TCPSock.SendData "FILELIST" & vbCrLf
349 Case 3:
350 If response = "ERROR" Then GoTo configError
351 fileList = response
352 Text1.Text = Text1.Text & response & vbCrLf
353 TCPSock.SendData "FQDN" & vbCrLf
354 Case 4:
355 If response = "ERROR" Then GoTo configError
356 Text1.Text = Text1.Text & response & vbCrLf
357 machineName = response
358 TCPSock.SendData "UDPUpdateTime" & vbCrLf
359 Case 5:
360 If response = "ERROR" Then GoTo configError
361 UDPUpdateTime = response
362 Text1.Text = Text1.Text & response & vbCrLf
363 TCPSock.SendData "TCPUpdateTime" & vbCrLf
364 Case 6:
365 If response = "ERROR" Then GoTo configError
366 TCPUpdateTime = response
367 Text1.Text = Text1.Text & response & vbCrLf
368 TCPSock.SendData "ENDCONFIG" & vbCrLf
369 Case 7:
370 If Not response = "OK" Then GoTo configError
371 Text1.Text = Text1.Text & response & vbCrLf
372 TCPSock.SendData "FILTER" & vbCrLf
373 Case 8:
374 Text1.Text = Text1.Text & response & vbCrLf
375 ' We got a filter list here.
376 readTo = 0
377 ' Get hostname
378 readTo = InStr(1, response, ";", vbBinaryCompare)
379 filterHostname = Mid(response, 1, readTo - 1)
380 response = Mid(response, readTo + 1, Len(response))
381 ' Get UDP Port number
382 readTo = InStr(1, response, ";")
383 filterUDPPort = Mid(response, 1, readTo - 1)
384 response = Mid(response, readTo + 1, Len(response))
385 ' Get TCP Port number
386 filterTCPPort = response
387 TCPSock.SendData "END" & vbCrLf
388 Case 9:
389 If Not response = "OK" Then GoTo configError
390 connected = True
391 responseNumber = 0
392 ' We've finished with the socket now.
393 TCPSock.Close
394 Text1.Text = Text1.Text & response & vbCrLf
395 Status.Caption = "Configuration successful"
396 Label3.Caption = UDPUpdateTime
397 Label4.Caption = TCPUpdateTime
398 Timer1.Interval = 1000
399 End Select
400 Else
401 ' Perform a heartbeat (1.1)
402 heartBeating = True
403 On Error GoTo heartbeatError
404 Select Case responseNumber
405 Case 1:
406 If Not response = "OK" Then GoTo heartbeatError
407 Text1.Text = "Performing heartbeat: -" & vbCrLf
408 Text1.Text = Text1.Text & response & vbCrLf
409 TCPSock.SendData "CONFIG" & vbCrLf
410 Case 2:
411 If Not response = "OK" Then GoTo heartbeatError
412 Text1.Text = Text1.Text & response & vbCrLf
413 TCPSock.SendData fileList & vbCrLf
414 Case 3:
415 If Not response = "OK" Then GoTo heartbeatError
416 Text1.Text = Text1.Text & response & vbCrLf
417 TCPSock.SendData lastModified & vbCrLf
418 Case 4:
419 ' Reconfigure if the server configuration for the
420 ' host has been altered.
421 If Not response = "OK" Then
422 heartBeating = False
423 Reconfigure_Click
424 End If
425 Text1.Text = Text1.Text & response & vbCrLf
426 TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
427 Case 5:
428 If Not response = "OK" Then GoTo heartbeatError
429 Text1.Text = Text1.Text & response & vbCrLf
430 TCPSock.Close
431 Status.Caption = "Heartbeat sent successfully."
432 heartBeating = False
433 End Select
434
435 End If
436
437
438 Exit Sub
439
440 configError:
441 heartBeating = False
442 Status.Caption = "FAILED to get configuration from the server"
443 Exit Sub
444 heartbeatError:
445 heartBeating = False
446 Status.Caption = "Heatbeat FAILED"
447 Exit Sub
448 End Sub
449
450
451 ' Deal with the construction and sending of UDP packets.
452 Private Sub Timer1_Timer()
453
454 Label3.Caption = Label3.Caption - 1
455 Label4.Caption = Label4.Caption - 1
456
457 Status.Caption = ""
458
459 If Label3.Caption < 1 Then
460
461 ' prepare the contents of the XML packet.
462 seqNo = seqNo + 1
463
464 ' Windows machines can provide their NetBIOS name to assist
465 ' in identifying the machine.
466 netbiosName = TCPSock.LocalHostName
467
468 ' The I.P. address of the host machine.
469 LocalIP = TCPSock.LocalIP
470
471 ' The date according to the host machine (formatted as the
472 ' number of seconds since the epoch).
473 packetDate = Date2Num()
474
475 ' Attempt to return Windows version information with the API.
476 Dim verinfo As OSVERSIONINFO
477 verinfo.dwOSVersionInfoSize = Len(verinfo)
478 ret% = GetVersionEx(verinfo)
479 If ret% = 0 Then
480 Text1.Text = Text1.Text & vbCrLf & "Error getting Windows version Information"
481 End
482 End If
483
484 ' Now get all of the version information.
485 osName = GetVersion()
486 osVersionMajor = verinfo.dwMajorVersion
487 osVersionMinor = verinfo.dwMinorVersion
488 osBuild = verinfo.dwBuildNumber
489
490 ' Find out what type of processor the host is using.
491 Dim sysinfo As SYSTEM_INFO
492 GetSystemInfo sysinfo
493 Select Case sysinfo.dwProcessorType
494 Case PROCESSOR_INTEL_386
495 processorType = "Intel 386"
496 Case PROCESSOR_INTEL_486
497 processorType = "Intel 486"
498 Case PROCESSOR_INTEL_PENTIUM
499 processorType = "Intel Pentium variant"
500 Case PROCESSOR_MIPS_R4000
501 processorType = "MIPS R4000"
502 Case PROCESSOR_ALPHA_21064
503 processorType = "DEC Alpha 21064"
504 Case Else
505 processorType = "(unknown)"
506 End Select
507
508 ' Find the amount of swap memory and physical memory
509 ' (both free and total)
510 Dim memsts As MEMORYSTATUS
511 Dim memory&
512 GlobalMemoryStatus memsts
513 memory& = memsts.dwTotalPhys
514 memTotal = memory& \ 1048576
515 memory& = memsts.dwAvailPhys
516 memFree = memory& \ 1048576
517 memory& = memsts.dwTotalVirtual
518 swapTotal = memory& \ 1048576
519 memory& = memsts.dwAvailVirtual
520 swapFree = memory& \ 1048576
521
522 ' Cause the CUpTime class to capture its data.
523 CUpTime.Capture
524
525 ' Get the processor occupancy percentages.
526 cpu_time = CUpTime.CPUTime
527 percent_idle = CUpTime.PercentIdle
528
529 ' Get the uptime for the host. DO NOT use integer division here,
530 ' as this will cause the result to overflow if the machine has
531 ' been up for more than ~47 days.
532 uptime = CUpTime.MilliSecs / 1000#
533
534 ' Use the CNetWksta class to find out how many users are logged
535 ' on to the system.
536 userCount = wksta.LoggedOnUsers
537
538 ' build the contents of the XML packet
539 xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
540 "<os>" & _
541 "<netbios_name>" & netbiosName & "</netbios_name>" & _
542 "<name>" & osName & "</name>" & _
543 "<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
544 "<release>" & osBuild & "</release>" & _
545 "<platform>" & processorType & "</platform>" & _
546 "<uptime>" & uptime & "</uptime>" & _
547 "</os>" & _
548 "<users><count>" & userCount & "</count></users>" & _
549 "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
550 "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
551 "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
552 "</packet>"
553
554 ' Show the interested user what we are sending.
555 Text1.Text = "Last packet contained: -" & vbCrLf & xml
556
557 ' Use the first winsock control to send a UDP packet.
558 UDPSock.RemoteHost = filterHostname
559 UDPSock.RemotePort = filterUDPPort
560 UDPSock.SendData xml
561 Status.Caption = "UDP packet sent"
562 Label3.Caption = UDPUpdateTime
563 End If
564
565 If Label4.Caption < 1 Then
566 ' establish a TCP connection to a filter
567 TCPSock.Close
568 TCPSock.Connect filterHostname, filterTCPPort
569 Label4.Caption = TCPUpdateTime
570 End If
571
572 End Sub
573
574
575 ' Format the current date and time as a long integer representing
576 ' the number of seconds since the epoch.
577 Function Date2Num() As Long
578 Dim x As Long
579 x = DateDiff("s", "1-1-1970", Now)
580 Date2Num = x
581 End Function