ViewVC Help

View File | Revision Log | Show Annotations | Revision Graph | Root Listing

root/i-scream/projects/cms/source/host/winhost/nettest.frm

Comparing projects/cms/source/host/winhost/nettest.frm (file contents):
Revision 1.5 by pjm2, Fri Feb 23 10:34:47 2001 UTC vs.
Revision 1.38 by tdb, Mon Mar 19 13:02:36 2001 UTC

#	Line 1 | Line 1
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         =   "TCP/UDP Test program"
7	<	ClientHeight    =   5655
6	>	Caption         =   "i-scream Winhost"
7	>	ClientHeight    =   1380
8		ClientLeft      =   45
9		ClientTop       =   330
10	<	ClientWidth     =   5670
10	>	ClientWidth     =   4635
11	>	Icon            =   "nettest.frx":0000
12		LinkTopic       =   "Form1"
13		MaxButton       =   0   'False
14		MinButton       =   0   'False
15	<	ScaleHeight     =   5655
16	<	ScaleWidth      =   5670
15	>	ScaleHeight     =   1380
16	>	ScaleWidth      =   4635
17		ShowInTaskbar   =   0   'False
18	<	StartUpPosition =   3  'Windows Default
19	<	Begin VB.CommandButton Command3
20	<	Caption         =   "TCP to Filter"
21	<	Height          =   375
22	<	Left            =   3720
23	<	TabIndex        =   5
24	<	Top             =   2520
25	<	Width           =   1575
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 Text4
29	<	Height          =   2535
30	<	Left            =   240
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        =   4
35	<	Text            =   "nettest.frx":0000
36	<	Top             =   3000
33	<	Width           =   5055
34	>	TabIndex        =   7
35	>	Top             =   1440
36	>	Width           =   4395
37		End
38	<	Begin VB.CommandButton Command2
39	<	Caption         =   "TCP to FilterManager"
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            =   3360
62	<	TabIndex        =   3
63	<	Top             =   2040
64	<	Width           =   1935
61	>	Left            =   840
62	>	TabIndex        =   0
63	>	Top             =   3555
64	>	Width           =   2895
65		End
66		Begin MSWinsockLib.Winsock TCPSock
67	<	Left            =   4920
68	<	Top             =   120
67	>	Left            =   4080
68	>	Top             =   4200
69		_ExtentX        =   741
70		_ExtentY        =   741
71		_Version        =   393216
72		End
50	–	Begin VB.CommandButton Command1
51	–	Caption         =   "Send UDP"
52	–	Height          =   375
53	–	Left            =   4320
54	–	TabIndex        =   2
55	–	Top             =   1560
56	–	Width           =   975
57	–	End
58	–	Begin VB.TextBox Text1
59	–	Height          =   855
60	–	Left            =   360
61	–	TabIndex        =   0
62	–	Text            =   "<packet></packet>"
63	–	Top             =   600
64	–	Width           =   4935
65	–	End
73		Begin MSWinsockLib.Winsock UDPSock
74	<	Left            =   4320
75	<	Top             =   120
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	<	Caption         =   "Packet contents"
98	>	Alignment       =   1  'Right Justify
99	>	Caption         =   "Next UDP packet:"
100		Height          =   255
101	<	Left            =   360
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             =   360
131	<	Width           =   2895
130	>	Top             =   1035
131	>	Width           =   3180
132		End
133		End
134		Attribute VB_Name = "Form1"
#	Line 85 | Line 136 | Attribute VB_GlobalNameSpace = False
136		Attribute VB_Creatable = False
137		Attribute VB_PredeclaredId = True
138		Attribute VB_Exposed = False
139	+	' For the system tray bits
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		Dim filterManagerHostname As String
144	<	Dim filterManagerTCPPort As Integer
144	>	Dim filterManagerTCPPort As Long
145
146	+	Dim seqNo As Long
147	+	Dim machineName As String
148	+
149	+	Dim secondsRunning As Long
150	+
151		Dim filterHostname As String
152		Dim filterTCPPort As Integer
153		Dim filterUDPPort As Integer
154		Dim fileList As String
155		Dim lastModified As String
156
157	+	Dim fourtySevenDays As Integer
158	+
159	+	Dim UDPUpdateTime As Integer
160	+	Dim TCPUpdateTime As Integer
161	+
162		Dim protocolVersion As String
163		Dim connected As Boolean
164	<	Dim responseNumber As Integer
164	>	Dim heartBeating As Boolean
165
166	+	Dim CUpTime As New CUpTime
167	+	Dim wksta As New CNetWksta
168
169	<	Private Sub Command1_Click()
169	>	Dim windowBig As Boolean
170
171	<	' build the contents of the XML packet.
108	<	xml = "<packet></packet>"
171	>	Dim responseNumber As Integer
172
173	<	' Use the first winsock control to send a UDP packet.
111	<	UDPSock.RemoteHost = filterHostname
112	<	UDPSock.RemotePort = filterUDPPort
113	<	UDPSock.SendData xml
173	>	Private Sub Command1_Click()
174
175	<	End Sub
175	>	' Toggle visibility of the debug output.
176
177	<	Private Sub Command2_Click()
178	<
179	<	' establish a TCP connection to a filtermanager
180	<	TCPSock.Close
181	<	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
177	>	If windowBig Then
178	>	Form1.Height = 1755
179	>	windowBig = False
180	>	Else
181	>	Form1.Height = 4380
182	>	windowBig = True
183	>	End If
184
185		End Sub
186
125	–	Private Sub Command3_Click()
126	–	' establish a TCP connection to a filter
127	–	TCPSock.Close
128	–	TCPSock.Connect filterHostname, filterTCPPort
129	–	End Sub
130	–
187		Private Sub Form_Load()
188	+
189	+	If App.PrevInstance Then
190	+	x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
191	+	End
192	+	End If
193	+
194	+	' Assume the host is run within the first 47 days of the machine starting.
195	+	fourtySevenDays = 0
196	+
197		protocolVersion = "1.1"
198
199	+	Status.Caption = "Loading"
200	+	Form1.Caption = "i-scream Winhost " & protocolVersion
201	+
202	+	CUpTime.Init
203	+
204	+	If CUpTime.isWin9x Then
205	+	x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
206	+	End
207	+	End If
208	+
209	+	windowBig = False
210	+
211		''''TEMP
212	<	filterManagerHostname = "killigrew.ukc.ac.uk"
213	<	filterManagerTCPPort = 4567
214	<	Exit Sub
138	<	''' ENDTEMP
212	>	'filterManagerHostname = "killigrew.ukc.ac.uk"
213	>	'filterManagerTCPPort = 4567
214	>	''''' END TEMP
215
216	+	'GoTo skip
217		On Error GoTo iniError
218		Dim buf As String * 256
219		Dim length As Long
220	<	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
220	>	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
221		filterManagerHostname = Left$(buf, length)
222	<	length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
223	<	filterManagerTCPPort = Left$(buf, length)
222	>	length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
223	>	filterManagerTCPPort = length
224	>	If filterManagerHostname = "" Then
225	>	GoTo iniError
226	>	End If
227	>	On Error GoTo 0
228	>	skip:
229	>
230	>	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
231	>	Reconfigure_Click
232
233	+	SystemTray.Icon = Val(Form1.Icon)
234	+	SystemTray.Action = 0
235	+
236	+
237		Exit Sub
238
239		iniError:
240	<	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")
240	>	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")
241		End
242
243		End Sub
244
245	+	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
246	+	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")
247	+	If x = 7 Then
248	+	Cancel = True
249	+	Else
250	+	SystemTray.Action = 2
251	+	End If
252	+
253	+	End Sub
254	+
255	+	Private Sub Hide_Click()
256	+	Form1.Visible = False
257	+	SystemTray.Icon = Val(Form1.Icon)
258	+	End Sub
259	+
260	+
261	+	Private Sub Reconfigure_Click()
262	+	' establish a TCP connection to a filtermanager
263	+	If Not heartBeating Then
264	+	connected = False
265	+	TCPSock.Close
266	+	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
267	+	Else
268	+	Status.Caption = "Cannot reconfigure while heartbeating"
269	+	End If
270	+	End Sub
271	+
272	+
273	+
274	+	Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
275	+
276	+	Form1.Visible = True
277	+	Form1.SetFocus
278	+
279	+	End Sub
280	+
281		Private Sub TCPSock_Connect()
282	<
283	<	responseNumber = 0
282	>
283	>	responseNumber = 0
284
285		' Send something as soon as we connect to the server.
286		If connected = False Then
#	Line 178 | Line 303 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
303		' Remove linefeeds and returns from the line.
304		response = Replace(response, Chr(13), "")
305		response = Replace(response, Chr(10), "")
181	–	Text4.Text = Text4.Text & vbCrLf & response
306
307		If connected = False Then
308		' Perform TCP configuration (1.1)
#	Line 187 | Line 311 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
311		Case 1:
312		If Not response = "OK" Then GoTo configError
313		TCPSock.SendData "LASTMODIFIED" & vbCrLf
314	+	Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
315	+	Text1.Text = Text1.Text & response & vbCrLf
316		Case 2:
317		If response = "ERROR" Then GoTo configError
318		lastModified = response
319	+	Text1.Text = Text1.Text & response & vbCrLf
320		TCPSock.SendData "FILELIST" & vbCrLf
321	+	' New addition to the protocol.
322		Case 3:
323		If response = "ERROR" Then GoTo configError
324		fileList = response
325	<	TCPSock.SendData "UDPUpdateTime" & vbCrLf
325	>	Text1.Text = Text1.Text & response & vbCrLf
326	>	TCPSock.SendData "FQDN" & vbCrLf
327		Case 4:
328		If response = "ERROR" Then GoTo configError
329	<	TCPSock.SendData "TCPUpdateTime" & vbCrLf
329	>	Text1.Text = Text1.Text & response & vbCrLf
330	>	machineName = response
331	>	TCPSock.SendData "UDPUpdateTime" & vbCrLf
332		Case 5:
333		If response = "ERROR" Then GoTo configError
334	<	TCPSock.SendData "ENDCONFIG" & vbCrLf
334	>	UDPUpdateTime = response
335	>	Text1.Text = Text1.Text & response & vbCrLf
336	>	TCPSock.SendData "TCPUpdateTime" & vbCrLf
337		Case 6:
338	+	If response = "ERROR" Then GoTo configError
339	+	TCPUpdateTime = response
340	+	Text1.Text = Text1.Text & response & vbCrLf
341	+	TCPSock.SendData "ENDCONFIG" & vbCrLf
342	+	Case 7:
343		If Not response = "OK" Then GoTo configError
344	+	Text1.Text = Text1.Text & response & vbCrLf
345		TCPSock.SendData "FILTER" & vbCrLf
346	<	Case 7:
346	>	Case 8:
347	>	Text1.Text = Text1.Text & response & vbCrLf
348		'we got a filter list here.
349		readTo = 0
350		' get hostname
#	Line 218 | Line 358 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
358		' get TCP Port number
359		filterTCPPort = response
360		TCPSock.SendData "END" & vbCrLf
361	<	Case 8:
361	>	Case 9:
362		If Not response = "OK" Then GoTo configError
363		connected = True
364		responseNumber = 0
365		TCPSock.Close
366	<	Text4.Text = Text4.Text & vbCrLf & "  <closed>"
367	<	x = MsgBox("got config okay")
366	>	Text1.Text = Text1.Text & response & vbCrLf
367	>	'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
368	>	Status.Caption = "Configuration successful"
369	>	Label3.Caption = UDPUpdateTime
370	>	Label4.Caption = TCPUpdateTime
371	>	Timer1.Interval = 1000
372		End Select
373		Else
374		' Perform a heartbeat (1.1)
375	+	heartBeating = True
376		On Error GoTo heartbeatError
377		Select Case responseNumber
378		Case 1:
379		If Not response = "OK" Then GoTo heartbeatError
380	+	Text1.Text = "Performing heartbeat: -" & vbCrLf
381	+	Text1.Text = Text1.Text & response & vbCrLf
382		TCPSock.SendData "CONFIG" & vbCrLf
383		Case 2:
384		If Not response = "OK" Then GoTo heartbeatError
385	+	Text1.Text = Text1.Text & response & vbCrLf
386		TCPSock.SendData fileList & vbCrLf
387		Case 3:
388		If Not response = "OK" Then GoTo heartbeatError
389	+	Text1.Text = Text1.Text & response & vbCrLf
390		TCPSock.SendData lastModified & vbCrLf
391		Case 4:
392	<	If Not response = "OK" Then GoTo heartbeatError
392	>	If Not response = "OK" Then
393	>	heartBeating = False
394	>	Reconfigure_Click
395	>	End If
396	>	Text1.Text = Text1.Text & response & vbCrLf
397		TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
398		Case 5:
399		If Not response = "OK" Then GoTo heartbeatError
400	+	Text1.Text = Text1.Text & response & vbCrLf
401		TCPSock.Close
402	<	x = MsgBox("heartbeat sent okay.")
402	>	Status.Caption = "Heartbeat sent successfully."
403		End Select
404
405		End If
#	Line 254 | Line 408 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
408		Exit Sub
409
410		configError:
411	<	x = MsgBox("error doing configuration")
411	>	heartBeating = False
412	>	Status.Caption = "FAILED to get configuration from the server"
413	>	Exit Sub
414		heartbeatError:
415	<	x = MsgBox("error doing configuration")
415	>	heartBeating = False
416	>	Status.Caption = "Heatbeat FAILED"
417	>	Exit Sub
418		End Sub
419
420	+	Private Sub Timer1_Timer()
421	+
422	+	Label3.Caption = Label3.Caption - 1
423	+	Label4.Caption = Label4.Caption - 1
424	+
425	+	Status.Caption = ""
426	+
427	+	If Label3.Caption < 1 Then
428	+
429	+	' prepare the contents of the XML packet.
430	+	seqNo = seqNo + 1
431	+
432	+	netbiosName = TCPSock.LocalHostName
433	+
434	+	LocalIP = TCPSock.LocalIP
435	+	packetDate = Date2Num()
436	+
437	+
438	+	Dim verinfo As OSVERSIONINFO
439	+	verinfo.dwOSVersionInfoSize = Len(verinfo)
440	+	ret% = GetVersionEx(verinfo)
441	+	If ret% = 0 Then
442	+	MsgBox "Error getting Windows version Information"
443	+	End
444	+	End If
445	+
446	+	osName = GetVersion()
447	+	osVersionMajor = verinfo.dwMajorVersion
448	+	osVersionMinor = verinfo.dwMinorVersion
449	+	osBuild = verinfo.dwBuildNumber
450	+
451	+	Dim sysinfo As SYSTEM_INFO
452	+	GetSystemInfo sysinfo
453	+	Select Case sysinfo.dwProcessorType
454	+	Case PROCESSOR_INTEL_386
455	+	processorType = "Intel 386"
456	+	Case PROCESSOR_INTEL_486
457	+	processorType = "Intel 486"
458	+	Case PROCESSOR_INTEL_PENTIUM
459	+	processorType = "Intel Pentium variant"
460	+	Case PROCESSOR_MIPS_R4000
461	+	processorType = "MIPS R4000"
462	+	Case PROCESSOR_ALPHA_21064
463	+	processorType = "DEC Alpha 21064"
464	+	Case Else
465	+	processorType = "(unknown)"
466	+	End Select
467	+
468	+	Dim memsts As MEMORYSTATUS
469	+	Dim memory&
470	+	GlobalMemoryStatus memsts
471	+	memory& = memsts.dwTotalPhys
472	+	memTotal = memory& \ 1048576
473	+	memory& = memsts.dwAvailPhys
474	+	memFree = memory& \ 1048576
475	+	memory& = memsts.dwTotalVirtual
476	+	swapTotal = memory& \ 1048576
477	+	memory& = memsts.dwAvailVirtual
478	+	swapFree = memory& \ 1048576
479	+
480	+	CUpTime.Capture
481	+	cpu_time = CUpTime.CPUTime
482	+	percent_idle = CUpTime.PercentIdle
483	+
484	+	'' Doesn't work after 47 days :-/
485	+	'uptime = GetTickCount \ 1000
486	+
487	+	'secondsRunning = secondsRunning + UDPUpdateTime
488	+	'uptime = secondsRunning
489	+
490	+	uptime = CUpTime.MilliSecs / 1000#
491	+
492	+	userCount = wksta.LoggedOnUsers
493	+
494	+	' build the contents of the XML packet
495	+	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
496	+	"<os>" & _
497	+	"<netbios_name>" & netbiosName & "</netbios_name>" & _
498	+	"<name>" & osName & "</name>" & _
499	+	"<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
500	+	"<release>" & osBuild & "</release>" & _
501	+	"<platform>" & processorType & "</platform>" & _
502	+	"<uptime>" & uptime & "</uptime>" & _
503	+	"</os>" & _
504	+	"<users><count>" & userCount & "</count></users>" & _
505	+	"<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
506	+	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
507	+	"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
508	+	"</packet>"
509	+	Text1.Text = "Last packet contained: -" & vbCrLf & xml
510	+
511	+	' Use the first winsock control to send a UDP packet.
512	+	UDPSock.RemoteHost = filterHostname
513	+	UDPSock.RemotePort = filterUDPPort
514	+	UDPSock.SendData xml
515	+	Status.Caption = "UDP packet sent"
516	+	Label3.Caption = UDPUpdateTime
517	+	End If
518	+
519	+	If Label4.Caption < 1 Then
520	+	' establish a TCP connection to a filter
521	+	TCPSock.Close
522	+	TCPSock.Connect filterHostname, filterTCPPort
523	+	Label4.Caption = TCPUpdateTime
524	+	End If
525	+
526	+	End Sub
527	+
528	+	Function Date2Num() As Long
529	+	Dim x As Long
530	+	x = DateDiff("s", "1-1-1970", Now)
531	+	Date2Num = x
532	+	End Function

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines