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.10 by pjm2, Fri Feb 23 11:42:06 2001 UTC vs.
Revision 1.37 by pjm2, Mon Mar 19 10:32:43 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     =   4  'Fixed ToolWindow
5	>	BorderStyle     =   3  'Fixed Dialog
6		Caption         =   "i-scream Winhost"
7	<	ClientHeight    =   5655
7	>	ClientHeight    =   1380
8		ClientLeft      =   45
9	<	ClientTop       =   285
10	<	ClientWidth     =   5670
9	>	ClientTop       =   330
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.Timer Timer1
20	<	Left            =   4200
21	<	Top             =   1200
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          =   1575
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        =   1
35	<	Text            =   "nettest.frx":0000
36	<	Top             =   3000
29	<	Width           =   5055
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          =   495
61	<	Left            =   120
60	>	Height          =   375
61	>	Left            =   840
62		TabIndex        =   0
63	<	Top             =   120
63	>	Top             =   3555
64		Width           =   2895
65		End
66		Begin MSWinsockLib.Winsock TCPSock
67	<	Left            =   5160
68	<	Top             =   1200
67	>	Left            =   4080
68	>	Top             =   4200
69		_ExtentX        =   741
70		_ExtentY        =   741
71		_Version        =   393216
72		End
73		Begin MSWinsockLib.Winsock UDPSock
74	<	Left            =   4680
75	<	Top             =   1200
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":0742
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            =   3360
93	<	TabIndex        =   6
94	<	Top             =   480
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            =   3360
102	<	TabIndex        =   5
103	<	Top             =   120
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            =   4920
111	<	TabIndex        =   4
112	<	Top             =   480
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            =   4920
120	<	TabIndex        =   3
121	<	Top             =   120
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            =   120
129	<	TabIndex        =   2
130	<	Top             =   840
131	<	Width           =   5415
128	>	Left            =   0
129	>	TabIndex        =   1
130	>	Top             =   1035
131	>	Width           =   3180
132		End
133		End
134		Attribute VB_Name = "Form1"
#	Line 101 | 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.
127	<	xml = "<packet></packet>"
171	>	Dim responseNumber As Integer
172
173	<	' Use the first winsock control to send a UDP packet.
130	<	UDPSock.RemoteHost = filterHostname
131	<	UDPSock.RemotePort = filterUDPPort
132	<	UDPSock.SendData xml
133	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
173	>	Private Sub Command1_Click()
174
175	<	End Sub
175	>	' Toggle visibility of the debug output.
176
177	+	If windowBig Then
178	+	Form1.Height = 1755
179	+	windowBig = False
180	+	Else
181	+	Form1.Height = 4380
182	+	windowBig = True
183	+	End If
184
138	–	Private Sub Command3_Click()
139	–	' establish a TCP connection to a filter
140	–	TCPSock.Close
141	–	TCPSock.Connect filterHostname, filterTCPPort
185		End Sub
186
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	<
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	<	Reconfigure_Click
154	<	Exit Sub
155	<	''' 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	<	Status.Caption = "Connecting to Filter Manager"
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?", vbYesNo, "i-scream Winhost")
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	<	connected = False
264	<	TCPSock.Close
265	<	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
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
#	Line 212 | 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), "")
215	–	Text4.Text = Text4.Text & vbCrLf & response
306
307		If connected = False Then
308		' Perform TCP configuration (1.1)
#	Line 221 | 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	+	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		UDPUpdateTime = response
335	+	Text1.Text = Text1.Text & response & vbCrLf
336		TCPSock.SendData "TCPUpdateTime" & vbCrLf
337	<	Case 5:
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 6:
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 254 | 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>"
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
#	Line 267 | Line 372 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
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		Status.Caption = "Heartbeat sent successfully."
403		End Select
#	Line 293 | Line 408 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
408		Exit Sub
409
410		configError:
411	<	Status.Caption = "FAILED to get configuration"
411	>	heartBeating = False
412	>	Status.Caption = "FAILED to get configuration from the server"
413		Exit Sub
414		heartbeatError:
415	+	heartBeating = False
416		Status.Caption = "Heatbeat FAILED"
417		Exit Sub
418		End Sub
#	Line 308 | Line 425 | Private Sub Timer1_Timer()
425		Status.Caption = ""
426
427		If Label3.Caption < 1 Then
428	<	' build the contents of the XML packet.
429	<	xml = "<packet></packet>"
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
#	Line 327 | Line 524 | Private Sub Timer1_Timer()
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