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

Diff Legend

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