ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/host/vb_net_test/nettest.frm
Revision: 1.31
Committed: Wed Feb 28 12:04:17 2001 UTC (23 years ago) by pjm2
Branch: MAIN
CVS Tags: PROJECT_COMPLETION, HEAD
Changes since 1.30: +2 -2 lines
Log Message:
Netbios name is now sent in the UDP packet.

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 = 1185
8 ClientLeft = 45
9 ClientTop = 330
10 ClientWidth = 4710
11 Icon = "nettest.frx":0000
12 LinkTopic = "Form1"
13 MaxButton = 0 'False
14 MinButton = 0 'False
15 ScaleHeight = 1185
16 ScaleWidth = 4710
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 = 3960
24 TabIndex = 8
25 Top = 840
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 = 1200
36 Width = 4455
37 End
38 Begin VB.CommandButton Hide
39 Caption = "hide"
40 Height = 255
41 Left = 3960
42 TabIndex = 6
43 Top = 480
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 = 3480
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.Label Label2
82 Alignment = 1 'Right Justify
83 Caption = "Next heartbeat:"
84 Height = 255
85 Left = 120
86 TabIndex = 5
87 Top = 480
88 Width = 1455
89 End
90 Begin VB.Label Label1
91 Alignment = 1 'Right Justify
92 Caption = "Next UDP packet:"
93 Height = 255
94 Left = 120
95 TabIndex = 4
96 Top = 120
97 Width = 1455
98 End
99 Begin VB.Label Label4
100 BorderStyle = 1 'Fixed Single
101 Caption = "0"
102 Height = 255
103 Left = 1680
104 TabIndex = 3
105 Top = 480
106 Width = 615
107 End
108 Begin VB.Label Label3
109 BorderStyle = 1 'Fixed Single
110 Caption = "0"
111 Height = 255
112 Left = 1680
113 TabIndex = 2
114 Top = 120
115 Width = 615
116 End
117 Begin VB.Label Status
118 Alignment = 2 'Center
119 Caption = "Status:"
120 Height = 255
121 Left = 0
122 TabIndex = 1
123 Top = 840
124 Width = 3855
125 End
126 End
127 Attribute VB_Name = "Form1"
128 Attribute VB_GlobalNameSpace = False
129 Attribute VB_Creatable = False
130 Attribute VB_PredeclaredId = True
131 Attribute VB_Exposed = False
132 ' For the system tray bits
133 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
134 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
135
136 Dim filterManagerHostname As String
137 Dim filterManagerTCPPort As Long
138
139 Dim seqNo As Long
140 Dim machineName As String
141
142 Dim filterHostname As String
143 Dim filterTCPPort As Integer
144 Dim filterUDPPort As Integer
145 Dim fileList As String
146 Dim lastModified As String
147
148 Dim UDPUpdateTime As Integer
149 Dim TCPUpdateTime As Integer
150
151 Dim protocolVersion As String
152 Dim connected As Boolean
153
154 Dim CUpTime As New CUpTime
155 Dim wksta As New CNetWksta
156
157 Dim windowBig As Boolean
158
159 Dim responseNumber As Integer
160
161 Private Sub Command1_Click()
162
163 ' Toggle visibility of the debug output.
164
165 If windowBig Then
166 Form1.Height = 1500
167 windowBig = False
168 Else
169 Form1.Height = 4350
170 windowBig = True
171 End If
172
173 End Sub
174
175 Private Sub Form_Load()
176
177 If App.PrevInstance Then
178 x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
179 End
180 End If
181
182 protocolVersion = "1.1"
183
184 Status.Caption = "Loading"
185 Form1.Caption = "i-scream Winhost " & protocolVersion
186
187 CUpTime.Init
188
189 If CUpTime.isWin9x Then
190 x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
191 End
192 End If
193
194 windowBig = False
195
196 ''''TEMP
197 'filterManagerHostname = "killigrew.ukc.ac.uk"
198 'filterManagerTCPPort = 4567
199 ''''' END TEMP
200
201 'GoTo skip
202 On Error GoTo iniError
203 Dim buf As String * 256
204 Dim length As Long
205 length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
206 filterManagerHostname = Left$(buf, length)
207 length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
208 filterManagerTCPPort = length
209 If filterManagerHostname = "" Then
210 GoTo iniError
211 End If
212 On Error GoTo 0
213 skip:
214
215 Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
216 Reconfigure_Click
217
218 SystemTray.Icon = Val(Form1.Icon)
219 SystemTray.Action = 0
220
221
222 Exit Sub
223
224 iniError:
225 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")
226 End
227
228 End Sub
229
230 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
231 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")
232 If x = 7 Then
233 Cancel = True
234 Else
235 SystemTray.Action = 2
236 End If
237
238 End Sub
239
240 Private Sub Hide_Click()
241 Form1.Visible = False
242 SystemTray.Icon = Val(Form1.Icon)
243 End Sub
244
245 Private Sub Image1_Click()
246
247 End Sub
248
249 Private Sub Reconfigure_Click()
250 ' establish a TCP connection to a filtermanager
251 connected = False
252 TCPSock.Close
253 TCPSock.Connect filterManagerHostname, filterManagerTCPPort
254 End Sub
255
256
257
258 Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
259
260 Form1.Visible = True
261 Form1.SetFocus
262
263 End Sub
264
265 Private Sub TCPSock_Connect()
266
267 responseNumber = 0
268
269 ' Send something as soon as we connect to the server.
270 If connected = False Then
271 ' contact the FilterManager
272 TCPSock.SendData "STARTCONFIG" & vbCrLf
273 Else
274 ' Contact the Filter
275 TCPSock.SendData "HEARTBEAT" & vbCrLf
276 End If
277
278 End Sub
279
280 Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
281
282 responseNumber = responseNumber + 1
283
284 ' Get the line from the server.
285 TCPSock.GetData response, vbString, bytesTotal
286
287 ' Remove linefeeds and returns from the line.
288 response = Replace(response, Chr(13), "")
289 response = Replace(response, Chr(10), "")
290
291 If connected = False Then
292 ' Perform TCP configuration (1.1)
293 On Error GoTo configError
294 Select Case responseNumber
295 Case 1:
296 If Not response = "OK" Then GoTo configError
297 TCPSock.SendData "LASTMODIFIED" & vbCrLf
298 Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
299 Text1.Text = Text1.Text & response & vbCrLf
300 Case 2:
301 If response = "ERROR" Then GoTo configError
302 lastModified = response
303 Text1.Text = Text1.Text & response & vbCrLf
304 TCPSock.SendData "FILELIST" & vbCrLf
305 ' New addition to the protocol.
306 Case 3:
307 If response = "ERROR" Then GoTo configError
308 fileList = response
309 Text1.Text = Text1.Text & response & vbCrLf
310 TCPSock.SendData "FQDN" & vbCrLf
311 Case 4:
312 If response = "ERROR" Then GoTo configError
313 Text1.Text = Text1.Text & response & vbCrLf
314 machineName = response
315 TCPSock.SendData "UDPUpdateTime" & vbCrLf
316 Case 5:
317 If response = "ERROR" Then GoTo configError
318 UDPUpdateTime = response
319 Text1.Text = Text1.Text & response & vbCrLf
320 TCPSock.SendData "TCPUpdateTime" & vbCrLf
321 Case 6:
322 If response = "ERROR" Then GoTo configError
323 TCPUpdateTime = response
324 Text1.Text = Text1.Text & response & vbCrLf
325 TCPSock.SendData "ENDCONFIG" & vbCrLf
326 Case 7:
327 If Not response = "OK" Then GoTo configError
328 Text1.Text = Text1.Text & response & vbCrLf
329 TCPSock.SendData "FILTER" & vbCrLf
330 Case 8:
331 Text1.Text = Text1.Text & response & vbCrLf
332 'we got a filter list here.
333 readTo = 0
334 ' get hostname
335 readTo = InStr(1, response, ";", vbBinaryCompare)
336 filterHostname = Mid(response, 1, readTo - 1)
337 response = Mid(response, readTo + 1, Len(response))
338 ' get UDP Port number
339 readTo = InStr(1, response, ";")
340 filterUDPPort = Mid(response, 1, readTo - 1)
341 response = Mid(response, readTo + 1, Len(response))
342 ' get TCP Port number
343 filterTCPPort = response
344 TCPSock.SendData "END" & vbCrLf
345 Case 9:
346 If Not response = "OK" Then GoTo configError
347 connected = True
348 responseNumber = 0
349 TCPSock.Close
350 Text1.Text = Text1.Text & response & vbCrLf
351 'Text4.Text = Text4.Text & vbCrLf & " <closed>"
352 Status.Caption = "Configuration successful"
353 Label3.Caption = UDPUpdateTime
354 Label4.Caption = TCPUpdateTime
355 Timer1.Interval = 1000
356 End Select
357 Else
358 ' Perform a heartbeat (1.1)
359 On Error GoTo heartbeatError
360 Select Case responseNumber
361 Case 1:
362 If Not response = "OK" Then GoTo heartbeatError
363 Text1.Text = "Performing heartbeat: -" & vbCrLf
364 Text1.Text = Text1.Text & response & vbCrLf
365 TCPSock.SendData "CONFIG" & vbCrLf
366 Case 2:
367 If Not response = "OK" Then GoTo heartbeatError
368 Text1.Text = Text1.Text & response & vbCrLf
369 TCPSock.SendData fileList & vbCrLf
370 Case 3:
371 If Not response = "OK" Then GoTo heartbeatError
372 Text1.Text = Text1.Text & response & vbCrLf
373 TCPSock.SendData lastModified & vbCrLf
374 Case 4:
375 If Not response = "OK" Then GoTo heartbeatError
376 Text1.Text = Text1.Text & response & vbCrLf
377 TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
378 Case 5:
379 If Not response = "OK" Then GoTo heartbeatError
380 Text1.Text = Text1.Text & response & vbCrLf
381 TCPSock.Close
382 Status.Caption = "Heartbeat sent successfully."
383 End Select
384
385 End If
386
387
388 Exit Sub
389
390 configError:
391 Status.Caption = "FAILED to get configuration"
392 Exit Sub
393 heartbeatError:
394 Status.Caption = "Heatbeat FAILED"
395 Exit Sub
396 End Sub
397
398 Private Sub Timer1_Timer()
399
400 Label3.Caption = Label3.Caption - 1
401 Label4.Caption = Label4.Caption - 1
402
403 Status.Caption = ""
404
405 If Label3.Caption < 1 Then
406
407 ' prepare the contents of the XML packet.
408 seqNo = seqNo + 1
409
410 netbiosName = TCPSock.LocalHostName
411
412 LocalIP = TCPSock.LocalIP
413 packetDate = Date2Num()
414
415
416 Dim verinfo As OSVERSIONINFO
417 verinfo.dwOSVersionInfoSize = Len(verinfo)
418 ret% = GetVersionEx(verinfo)
419 If ret% = 0 Then
420 MsgBox "Error getting Windows version Information"
421 End
422 End If
423
424 osName = GetVersion()
425 osVersionMajor = verinfo.dwMajorVersion
426 osVersionMinor = verinfo.dwMinorVersion
427 osBuild = verinfo.dwBuildNumber
428
429 Dim sysinfo As SYSTEM_INFO
430 GetSystemInfo sysinfo
431 Select Case sysinfo.dwProcessorType
432 Case PROCESSOR_INTEL_386
433 processorType = "Intel 386"
434 Case PROCESSOR_INTEL_486
435 processorType = "Intel 486"
436 Case PROCESSOR_INTEL_PENTIUM
437 processorType = "Intel Pentium variant"
438 Case PROCESSOR_MIPS_R4000
439 processorType = "MIPS R4000"
440 Case PROCESSOR_ALPHA_21064
441 processorType = "DEC Alpha 21064"
442 Case Else
443 processorType = "(unknown)"
444 End Select
445
446 Dim memsts As MEMORYSTATUS
447 Dim memory&
448 GlobalMemoryStatus memsts
449 memory& = memsts.dwTotalPhys
450 memTotal = memory& \ 1048576
451 memory& = memsts.dwAvailPhys
452 memFree = memory& \ 1048576
453 memory& = memsts.dwTotalVirtual
454 swapTotal = memory& \ 1048576
455 memory& = memsts.dwAvailVirtual
456 swapFree = memory& \ 1048576
457
458 uptime = CUpTime.MilliSecs \ 1000
459
460 CUpTime.Capture
461 cpu_time = CUpTime.CPUTime
462 percent_idle = CUpTime.PercentIdle
463
464 userCount = wksta.LoggedOnUsers
465
466 ' build the contents of the XML packet
467 xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
468 "<os>" & _
469 "<netbios_name>" & netbiosName & "</netbios_name>" & _
470 "<name>" & osName & "</name>" & _
471 "<version>" & osVersionMajor & "</version>" & _
472 "<release>" & osBuild & "</release>" & _
473 "<platform>" & osName & "</platform>" & _
474 "<minor_version>" & osVersionMinor & "</minor_version>" & _
475 "<processor>" & processorType & "</processor>" & _
476 "<uptime>" & uptime & "</uptime>" & _
477 "</os>" & _
478 "<users><count>" & userCount & "</count></users>" & _
479 "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
480 "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
481 "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
482 "</packet>"
483 Text1.Text = "Last packet contained: -" & vbCrLf & xml
484
485 ' Use the first winsock control to send a UDP packet.
486 UDPSock.RemoteHost = filterHostname
487 UDPSock.RemotePort = filterUDPPort
488 UDPSock.SendData xml
489 Status.Caption = "UDP packet sent"
490 Label3.Caption = UDPUpdateTime
491 End If
492
493 If Label4.Caption < 1 Then
494 ' establish a TCP connection to a filter
495 TCPSock.Close
496 TCPSock.Connect filterHostname, filterTCPPort
497 Label4.Caption = TCPUpdateTime
498 End If
499
500 End Sub
501
502 Function Date2Num() As Long
503 Dim x As Long
504 x = DateDiff("s", "1-1-1970", Now)
505 Date2Num = x
506 End Function