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

Diff Legend

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