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.12 by pjm2, Fri Feb 23 12:01:14 2001 UTC vs.
Revision 1.29 by pjm2, Wed Feb 28 10:45:37 2001 UTC

#	Line 2 | Line 2 | 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    =   1185
8		ClientLeft      =   45
9	<	ClientTop       =   285
9	>	ClientTop       =   330
10		ClientWidth     =   4710
11	+	Icon            =   "nettest.frx":0000
12		LinkTopic       =   "Form1"
13		MaxButton       =   0   'False
14	<	ScaleHeight     =   5655
14	>	MinButton       =   0   'False
15	>	ScaleHeight     =   1185
16		ScaleWidth      =   4710
17		ShowInTaskbar   =   0   'False
18	<	StartUpPosition =   3  'Windows Default
19	<	Begin VB.CommandButton Hide
20	<	Caption         =   "Hide Window"
21	<	Height          =   375
22	<	Left            =   3120
23	<	TabIndex        =   7
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           =   1455
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            =   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
37	–	Begin VB.TextBox Text4
38	–	Height          =   1575
39	–	Left            =   240
40	–	MultiLine       =   -1  'True
41	–	ScrollBars      =   2  'Vertical
42	–	TabIndex        =   1
43	–	Text            =   "nettest.frx":0000
44	–	Top             =   3000
45	–	Width           =   3975
46	–	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             =   3480
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
#	Line 71 | Line 82 | Begin VB.Form Form1
82		Alignment       =   1  'Right Justify
83		Caption         =   "Next heartbeat:"
84		Height          =   255
85	<	Left            =   2400
86	<	TabIndex        =   6
85	>	Left            =   120
86	>	TabIndex        =   5
87		Top             =   480
88		Width           =   1455
89		End
#	Line 80 | Line 91 | Begin VB.Form Form1
91		Alignment       =   1  'Right Justify
92		Caption         =   "Next UDP packet:"
93		Height          =   255
94	<	Left            =   2400
95	<	TabIndex        =   5
94	>	Left            =   120
95	>	TabIndex        =   4
96		Top             =   120
97		Width           =   1455
98		End
#	Line 89 | Line 100 | Begin VB.Form Form1
100		BorderStyle     =   1  'Fixed Single
101		Caption         =   "0"
102		Height          =   255
103	<	Left            =   3960
104	<	TabIndex        =   4
103	>	Left            =   1680
104	>	TabIndex        =   3
105		Top             =   480
106		Width           =   615
107		End
#	Line 98 | Line 109 | Begin VB.Form Form1
109		BorderStyle     =   1  'Fixed Single
110		Caption         =   "0"
111		Height          =   255
112	<	Left            =   3960
113	<	TabIndex        =   3
112	>	Left            =   1680
113	>	TabIndex        =   2
114		Top             =   120
115		Width           =   615
116		End
#	Line 107 | Line 118 | Begin VB.Form Form1
118		Alignment       =   2  'Center
119		Caption         =   "Status:"
120		Height          =   255
121	<	Left            =   120
122	<	TabIndex        =   2
123	<	Top             =   1320
124	<	Width           =   4455
121	>	Left            =   0
122	>	TabIndex        =   1
123	>	Top             =   840
124	>	Width           =   3855
125		End
126		End
127		Attribute VB_Name = "Form1"
#	Line 118 | 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 filterHostname As String
143		Dim filterTCPPort As Integer
144		Dim filterUDPPort As Integer
#	Line 135 | Line 150 | Dim TCPUpdateTime As Integer
150
151		Dim protocolVersion As String
152		Dim connected As Boolean
138	–	Dim responseNumber As Integer
153
154	+	Dim CUpTime As New CUpTime
155	+	Dim wksta As New CNetWksta
156
157	<	Private Sub Command1_Click()
157	>	Dim windowBig As Boolean
158
159	<	' build the contents of the XML packet.
144	<	xml = "<packet></packet>"
159	>	Dim responseNumber As Integer
160
161	<	' Use the first winsock control to send a UDP packet.
147	<	UDPSock.RemoteHost = filterHostname
148	<	UDPSock.RemotePort = filterUDPPort
149	<	UDPSock.SendData xml
150	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
161	>	Private Sub Command1_Click()
162
163	<	End Sub
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
155	–	Private Sub Command3_Click()
156	–	' establish a TCP connection to a filter
157	–	TCPSock.Close
158	–	TCPSock.Connect filterHostname, filterTCPPort
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	<
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	<	Reconfigure_Click
171	<	Exit Sub
172	<	''' ENDTEMP
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")
205	>	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
206		filterManagerHostname = Left$(buf, length)
207	<	length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
208	<	filterManagerTCPPort = 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	<	Status.Caption = "Connecting to Filter Manager"
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.", 48, "Configuration not found")
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
#	Line 193 | Line 231 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
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
197	–	SystemTray.Action = 2
237
238		End Sub
239
240		Private Sub Hide_Click()
241		Form1.Visible = False
242		SystemTray.Icon = Val(Form1.Icon)
204	–	SystemTray.Action = 0
243		End Sub
244
245		Private Sub Reconfigure_Click()
#	Line 216 | Line 254 | End Sub
254		Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
255
256		Form1.Visible = True
219	–	SystemTray.Action = 2
257		Form1.SetFocus
221	–
258
259		End Sub
260
#	Line 247 | Line 283 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
283		' Remove linefeeds and returns from the line.
284		response = Replace(response, Chr(13), "")
285		response = Replace(response, Chr(10), "")
250	–	Text4.Text = Text4.Text & vbCrLf & response
286
287		If connected = False Then
288		' Perform TCP configuration (1.1)
#	Line 256 | Line 291 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
291		Case 1:
292		If Not response = "OK" Then GoTo configError
293		TCPSock.SendData "LASTMODIFIED" & vbCrLf
294	+	Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
295	+	Text1.Text = Text1.Text & response & vbCrLf
296		Case 2:
297		If response = "ERROR" Then GoTo configError
298		lastModified = response
299	+	Text1.Text = Text1.Text & response & vbCrLf
300		TCPSock.SendData "FILELIST" & vbCrLf
301	+	' New addition to the protocol.
302		Case 3:
303		If response = "ERROR" Then GoTo configError
304		fileList = response
305	<	TCPSock.SendData "UDPUpdateTime" & vbCrLf
305	>	Text1.Text = Text1.Text & response & vbCrLf
306	>	TCPSock.SendData "FQDN" & vbCrLf
307		Case 4:
308		If response = "ERROR" Then GoTo configError
309	+	Text1.Text = Text1.Text & response & vbCrLf
310	+	machineName = response
311	+	TCPSock.SendData "UDPUpdateTime" & vbCrLf
312	+	Case 5:
313	+	If response = "ERROR" Then GoTo configError
314		UDPUpdateTime = response
315	+	Text1.Text = Text1.Text & response & vbCrLf
316		TCPSock.SendData "TCPUpdateTime" & vbCrLf
317	<	Case 5:
317	>	Case 6:
318		If response = "ERROR" Then GoTo configError
319		TCPUpdateTime = response
320	+	Text1.Text = Text1.Text & response & vbCrLf
321		TCPSock.SendData "ENDCONFIG" & vbCrLf
322	<	Case 6:
322	>	Case 7:
323		If Not response = "OK" Then GoTo configError
324	+	Text1.Text = Text1.Text & response & vbCrLf
325		TCPSock.SendData "FILTER" & vbCrLf
326	<	Case 7:
326	>	Case 8:
327	>	Text1.Text = Text1.Text & response & vbCrLf
328		'we got a filter list here.
329		readTo = 0
330		' get hostname
#	Line 289 | Line 338 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
338		' get TCP Port number
339		filterTCPPort = response
340		TCPSock.SendData "END" & vbCrLf
341	<	Case 8:
341	>	Case 9:
342		If Not response = "OK" Then GoTo configError
343		connected = True
344		responseNumber = 0
345		TCPSock.Close
346	<	Text4.Text = Text4.Text & vbCrLf & "  <closed>"
346	>	Text1.Text = Text1.Text & response & vbCrLf
347	>	'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
348		Status.Caption = "Configuration successful"
349		Label3.Caption = UDPUpdateTime
350		Label4.Caption = TCPUpdateTime
#	Line 306 | Line 356 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
356		Select Case responseNumber
357		Case 1:
358		If Not response = "OK" Then GoTo heartbeatError
359	+	Text1.Text = "Performing heartbeat: -" & vbCrLf
360	+	Text1.Text = Text1.Text & response & vbCrLf
361		TCPSock.SendData "CONFIG" & vbCrLf
362		Case 2:
363		If Not response = "OK" Then GoTo heartbeatError
364	+	Text1.Text = Text1.Text & response & vbCrLf
365		TCPSock.SendData fileList & vbCrLf
366		Case 3:
367		If Not response = "OK" Then GoTo heartbeatError
368	+	Text1.Text = Text1.Text & response & vbCrLf
369		TCPSock.SendData lastModified & vbCrLf
370		Case 4:
371		If Not response = "OK" Then GoTo heartbeatError
372	+	Text1.Text = Text1.Text & response & vbCrLf
373		TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
374		Case 5:
375		If Not response = "OK" Then GoTo heartbeatError
376	+	Text1.Text = Text1.Text & response & vbCrLf
377		TCPSock.Close
378		Status.Caption = "Heartbeat sent successfully."
379		End Select
#	Line 343 | Line 399 | Private Sub Timer1_Timer()
399		Status.Caption = ""
400
401		If Label3.Caption < 1 Then
402	<	' build the contents of the XML packet.
403	<	xml = "<packet></packet>"
402	>
403	>	' prepare the contents of the XML packet.
404	>	seqNo = seqNo + 1
405	>
406	>	' Comment this line in the next protocol
407	>	'machineName = TCPSock.LocalHostName
408	>
409	>	LocalIP = TCPSock.LocalIP
410	>	packetDate = Date2Num()
411	>
412	>
413	>	Dim verinfo As OSVERSIONINFO
414	>	verinfo.dwOSVersionInfoSize = Len(verinfo)
415	>	ret% = GetVersionEx(verinfo)
416	>	If ret% = 0 Then
417	>	MsgBox "Error getting Windows version Information"
418	>	End
419	>	End If
420	>
421	>	osName = GetVersion()
422	>	osVersionMajor = verinfo.dwMajorVersion
423	>	osVersionMinor = verinfo.dwMinorVersion
424	>	osBuild = verinfo.dwBuildNumber
425	>
426	>	Dim sysinfo As SYSTEM_INFO
427	>	GetSystemInfo sysinfo
428	>	Select Case sysinfo.dwProcessorType
429	>	Case PROCESSOR_INTEL_386
430	>	processorType = "Intel 386"
431	>	Case PROCESSOR_INTEL_486
432	>	processorType = "Intel 486"
433	>	Case PROCESSOR_INTEL_PENTIUM
434	>	processorType = "Intel Pentium variant"
435	>	Case PROCESSOR_MIPS_R4000
436	>	processorType = "MIPS R4000"
437	>	Case PROCESSOR_ALPHA_21064
438	>	processorType = "DEC Alpha 21064"
439	>	Case Else
440	>	processorType = "(unknown)"
441	>	End Select
442	>
443	>	Dim memsts As MEMORYSTATUS
444	>	Dim memory&
445	>	GlobalMemoryStatus memsts
446	>	memory& = memsts.dwTotalPhys
447	>	memTotal = memory& \ 1048576
448	>	memory& = memsts.dwAvailPhys
449	>	memFree = memory& \ 1048576
450	>	memory& = memsts.dwTotalVirtual
451	>	swapTotal = memory& \ 1048576
452	>	memory& = memsts.dwAvailVirtual
453	>	swapFree = memory& \ 1048576
454	>
455	>	uptime = CUpTime.MilliSecs \ 1000
456	>
457	>	CUpTime.Capture
458	>	cpu_time = CUpTime.CPUTime
459	>	percent_idle = CUpTime.PercentIdle
460	>
461	>	userCount = wksta.LoggedOnUsers
462	>
463	>	' build the contents of the XML packet
464	>	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
465	>	"<os>" & _
466	>	"<name>" & osName & "</name>" & _
467	>	"<version>" & osVersionMajor & "</version>" & _
468	>	"<release>" & osBuild & "</release>" & _
469	>	"<platform>" & osName & "</platform>" & _
470	>	"<minor_version>" & osVersionMinor & "</minor_version>" & _
471	>	"<processor>" & processorType & "</processor>" & _
472	>	"<uptime>" & uptime & "</uptime>" & _
473	>	"</os>" & _
474	>	"<users><count>" & userCount & "</count></users>" & _
475	>	"<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
476	>	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
477	>	"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
478	>	"</packet>"
479	>	Text1.Text = "Last packet contained: -" & vbCrLf & xml
480
481		' Use the first winsock control to send a UDP packet.
482		UDPSock.RemoteHost = filterHostname
#	Line 362 | Line 494 | Private Sub Timer1_Timer()
494		End If
495
496		End Sub
497	+
498	+	Function Date2Num() As Long
499	+	Dim x As Long
500	+	x = DateDiff("s", "1-1-1970", Now)
501	+	Date2Num = x
502	+	End Function

Diff Legend

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