[ViewVC] Diff of: i-scream/projects/cms/source/host/winhost/nettest.frm

Comparing projects/cms/source/host/winhost/nettest.frm (file contents):
Revision 1.17 by pjm2, Fri Feb 23 17:37:04 2001 UTC vs.
Revision 1.37 by pjm2, Mon Mar 19 10:32:43 2001 UTC

#	Line 4 \| Line 4 \| Object = "{33155A3D-0CE0-11D1-A6B4-444553540000}#1.0#0
4		Begin VB.Form Form1
5		BorderStyle = 3 'Fixed Dialog
6		Caption = "i-scream Winhost"
7	<	ClientHeight = 5655
7	>	ClientHeight = 1380
8		ClientLeft = 45
9		ClientTop = 330
10	<	ClientWidth = 4710
10	>	ClientWidth = 4635
11	>	Icon = "nettest.frx":0000
12		LinkTopic = "Form1"
13		MaxButton = 0 'False
14		MinButton = 0 'False
15	<	ScaleHeight = 5655
16	<	ScaleWidth = 4710
15	>	ScaleHeight = 1380
16	>	ScaleWidth = 4635
17		ShowInTaskbar = 0 'False
18	<	StartUpPosition = 3 'Windows Default
19	<	Begin VB.CommandButton Hide
20	<	Caption = "Hide Window"
21	<	Height = 375
22	<	Left = 3120
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 = 840
36	<	Width = 1455
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 = 2160
48	<	Top = 1800
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 = 2760
56	<	Top = 1800
55	>	Left = 3120
56	>	Top = 4200
57		End
38	–	Begin VB.TextBox Text4
39	–	Height = 1575
40	–	Left = 240
41	–	MultiLine = -1 'True
42	–	ScrollBars = 2 'Vertical
43	–	TabIndex = 1
44	–	Text = "nettest.frx":0000
45	–	Top = 3000
46	–	Width = 3975
47	–	End
58		Begin VB.CommandButton Reconfigure
59		Caption = "Reconfigure with FilterManager"
60		Height = 375
61	<	Left = 120
61	>	Left = 840
62		TabIndex = 0
63	<	Top = 840
63	>	Top = 3555
64		Width = 2895
65		End
66		Begin MSWinsockLib.Winsock TCPSock
67	<	Left = 3720
68	<	Top = 1800
67	>	Left = 4080
68	>	Top = 4200
69		_ExtentX = 741
70		_ExtentY = 741
71		_Version = 393216
72		End
73		Begin MSWinsockLib.Winsock UDPSock
74	<	Left = 3240
75	<	Top = 1800
74	>	Left = 3600
75	>	Top = 4200
76		_ExtentX = 741
77		_ExtentY = 741
78		_Version = 393216
79		Protocol = 1
80		End
81	<	Begin VB.Label Label5
82	<	Caption = "b e t a"
83	<	BeginProperty Font
84	<	Name = "MS Sans Serif"
85	<	Size = 24
86	<	Charset = 0
77	<	Weight = 700
78	<	Underline = 0 'False
79	<	Italic = 0 'False
80	<	Strikethrough = 0 'False
81	<	EndProperty
82	<	Height = 615
83	<	Left = 240
84	<	TabIndex = 8
85	<	Top = 120
86	<	Width = 1815
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 = 2400
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 = 2400
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 = 3960
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 = 3960
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 = 1320
131	<	Width = 4455
128	>	Left = 0
129	>	TabIndex = 1
130	>	Top = 1035
131	>	Width = 3180
132		End
133		End
134		Attribute VB_Name = "Form1"
#	Line 141 \| Line 141 \| Private Declare Function GetPrivateProfileString Lib "
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 heartBeating As Boolean
165
166	<	'Dim CUpTime As New CUpTime
166	>	Dim CUpTime As New CUpTime
167	>	Dim wksta As New CNetWksta
168
169	+	Dim windowBig As Boolean
170	+
171		Dim responseNumber As Integer
172
173	+	Private Sub Command1_Click()
174	+
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	+
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
199		Status.Caption = "Loading"
200	<	'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
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
212	>	'filterManagerHostname = "killigrew.ukc.ac.uk"
213	>	'filterManagerTCPPort = 4567
214		''''' END TEMP
215
216	<	GoTo skip
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"
230	>	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
231		Reconfigure_Click
232
233	<	Form1.Show
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
#	Line 214 \| Line 257 \| Private Sub Hide_Click()
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
#	Line 227 \| Line 275 \| Private Sub SystemTray_MouseDblClk(ByVal Button As Int
275
276		Form1.Visible = True
277		Form1.SetFocus
230	–
278
279		End Sub
280
#	Line 256 \| 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), "")
259	–	Text4.Text = Text4.Text & vbCrLf & response
306
307		If connected = False Then
308		' Perform TCP configuration (1.1)
#	Line 265 \| 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 298 \| 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 311 \| 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 337 \| 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 355 \| Line 428 \| Private Sub Timer1_Timer()
428
429		' prepare the contents of the XML packet.
430		seqNo = seqNo + 1
431	<	machineName = TCPSock.LocalHostName
431	>
432	>	netbiosName = TCPSock.LocalHostName
433	>
434		LocalIP = TCPSock.LocalIP
435		packetDate = Date2Num()
436
#	Line 368 \| Line 443 \| Private Sub Timer1_Timer()
443		End
444		End If
445
446	<	osName = getVersion()
446	>	osName = GetVersion()
447		osVersionMajor = verinfo.dwMajorVersion
448		osVersionMinor = verinfo.dwMinorVersion
449		osBuild = verinfo.dwBuildNumber
#	Line 394 \| Line 469 \| Private Sub Timer1_Timer()
469		Dim memory&
470		GlobalMemoryStatus memsts
471		memory& = memsts.dwTotalPhys
472	<	memTotal = memory& \ 1024
472	>	memTotal = memory& \ 1048576
473		memory& = memsts.dwAvailPhys
474	<	memFree = memory& \ 1024
474	>	memFree = memory& \ 1048576
475		memory& = memsts.dwTotalVirtual
476	<	swapTotal = memory& \ 1024
476	>	swapTotal = memory& \ 1048576
477		memory& = memsts.dwAvailVirtual
478	<	swapFree = memory& \ 1024
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 & "</version>" & _
499	>	"<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
500		"<release>" & osBuild & "</release>" & _
501	<	"<platform>" & osName & "</platform>" & _
502	<	"<minor_version>" & osVersionMinor & "</minor_version>" & _
413	<	"<processor>" & processorType & "</processor>" & _
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	<	Text4.Text = Text4.Text + xml
509	>	Text1.Text = "Last packet contained: -" & vbCrLf & xml
510
511		' Use the first winsock control to send a UDP packet.
512		UDPSock.RemoteHost = filterHostname

Diff Legend

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

Comparing projects/cms/source/host/winhost/nettest.frm (file contents): Revision 1.17 by pjm2, Fri Feb 23 17:37:04 2001 UTC vs. Revision 1.37 by pjm2, Mon Mar 19 10:32:43 2001 UTC

Diff Legend

Comparing projects/cms/source/host/winhost/nettest.frm (file contents):
Revision 1.17 by pjm2, Fri Feb 23 17:37:04 2001 UTC vs.
Revision 1.37 by pjm2, Mon Mar 19 10:32:43 2001 UTC