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.25 by pjm2, Wed Feb 28 08:19:00 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    =   1275
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     =   1275
16	>	ScaleWidth      =   4710
17		ShowInTaskbar   =   0   'False
18	<	StartUpPosition =   3  'Windows Default
19	<	Begin VB.CommandButton Command3
20	<	Caption         =   "TCP to Filter"
18	>	StartUpPosition =   2  'CenterScreen
19	>	Visible         =   0   'False
20	>	Begin VB.CommandButton Hide
21	>	Caption         =   "Hide Window"
22		Height          =   375
23	<	Left            =   3720
24	<	TabIndex        =   5
25	<	Top             =   2520
26	<	Width           =   1575
23	>	Left            =   3120
24	>	TabIndex        =   6
25	>	Top             =   480
26	>	Width           =   1455
27		End
28	<	Begin VB.TextBox Text4
29	<	Height          =   2535
30	<	Left            =   240
31	<	MultiLine       =   -1  'True
32	<	ScrollBars      =   2  'Vertical
33	<	TabIndex        =   4
34	<	Text            =   "nettest.frx":0000
32	<	Top             =   3000
33	<	Width           =   5055
28	>	Begin SysTray.SystemTray SystemTray
29	>	Left            =   2160
30	>	Top             =   1800
31	>	_ExtentX        =   847
32	>	_ExtentY        =   847
33	>	SysTrayText     =   "i-scream Winhost"
34	>	IconFile        =   0
35		End
36	<	Begin VB.CommandButton Command2
37	<	Caption         =   "TCP to FilterManager"
36	>	Begin VB.Timer Timer1
37	>	Left            =   2760
38	>	Top             =   1800
39	>	End
40	>	Begin VB.CommandButton Reconfigure
41	>	Caption         =   "Reconfigure with FilterManager"
42		Height          =   375
43	<	Left            =   3360
44	<	TabIndex        =   3
45	<	Top             =   2040
46	<	Width           =   1935
43	>	Left            =   120
44	>	TabIndex        =   0
45	>	Top             =   480
46	>	Width           =   2895
47		End
48		Begin MSWinsockLib.Winsock TCPSock
49	<	Left            =   4920
50	<	Top             =   120
49	>	Left            =   3720
50	>	Top             =   1800
51		_ExtentX        =   741
52		_ExtentY        =   741
53		_Version        =   393216
54		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
55		Begin MSWinsockLib.Winsock UDPSock
56	<	Left            =   4320
57	<	Top             =   120
56	>	Left            =   3240
57	>	Top             =   1800
58		_ExtentX        =   741
59		_ExtentY        =   741
60		_Version        =   393216
61		Protocol        =   1
62		End
63	+	Begin VB.Label Label2
64	+	Alignment       =   1  'Right Justify
65	+	Caption         =   "Next heartbeat:"
66	+	Height          =   255
67	+	Left            =   2400
68	+	TabIndex        =   5
69	+	Top             =   120
70	+	Width           =   1455
71	+	End
72		Begin VB.Label Label1
73	<	Caption         =   "Packet contents"
73	>	Alignment       =   1  'Right Justify
74	>	Caption         =   "Next UDP packet:"
75		Height          =   255
76	<	Left            =   360
76	>	Left            =   120
77	>	TabIndex        =   4
78	>	Top             =   120
79	>	Width           =   1455
80	>	End
81	>	Begin VB.Label Label4
82	>	BorderStyle     =   1  'Fixed Single
83	>	Caption         =   "0"
84	>	Height          =   255
85	>	Left            =   3960
86	>	TabIndex        =   3
87	>	Top             =   120
88	>	Width           =   615
89	>	End
90	>	Begin VB.Label Label3
91	>	BorderStyle     =   1  'Fixed Single
92	>	Caption         =   "0"
93	>	Height          =   255
94	>	Left            =   1680
95	>	TabIndex        =   2
96	>	Top             =   120
97	>	Width           =   615
98	>	End
99	>	Begin VB.Label Status
100	>	Alignment       =   2  'Center
101	>	Caption         =   "Status:"
102	>	Height          =   255
103	>	Left            =   0
104		TabIndex        =   1
105	<	Top             =   360
106	<	Width           =   2895
105	>	Top             =   960
106	>	Width           =   4695
107		End
108		End
109		Attribute VB_Name = "Form1"
#	Line 85 | Line 111 | Attribute VB_GlobalNameSpace = False
111		Attribute VB_Creatable = False
112		Attribute VB_PredeclaredId = True
113		Attribute VB_Exposed = False
114	+	' For the system tray bits
115		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
116		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
117
118		Dim filterManagerHostname As String
119	<	Dim filterManagerTCPPort As Integer
119	>	Dim filterManagerTCPPort As Long
120
121	+	Dim seqNo As Long
122	+	Dim machineName As String
123	+
124		Dim filterHostname As String
125		Dim filterTCPPort As Integer
126		Dim filterUDPPort As Integer
127		Dim fileList As String
128		Dim lastModified As String
129
130	+	Dim UDPUpdateTime As Integer
131	+	Dim TCPUpdateTime As Integer
132	+
133		Dim protocolVersion As String
134		Dim connected As Boolean
102	–	Dim responseNumber As Integer
135
136	+	Dim CUpTime As New CUpTime
137	+	Dim wksta As New CNetWksta
138
139	<	Private Sub Command1_Click()
139	>	Dim responseNumber As Integer
140
107	–	' build the contents of the XML packet.
108	–	xml = "<packet></packet>"
109	–
110	–	' Use the first winsock control to send a UDP packet.
111	–	UDPSock.RemoteHost = filterHostname
112	–	UDPSock.RemotePort = filterUDPPort
113	–	UDPSock.SendData xml
114	–
115	–	End Sub
116	–
117	–	Private Sub Command2_Click()
118	–
119	–	' establish a TCP connection to a filtermanager
120	–	TCPSock.Close
121	–	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
122	–
123	–	End Sub
124	–
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	–
141		Private Sub Form_Load()
142	+
143	+	If App.PrevInstance Then
144	+	x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
145	+	End
146	+	End If
147	+
148		protocolVersion = "1.1"
149
150	+	Status.Caption = "Loading"
151	+	Form1.Caption = "i-scream Winhost " & protocolVersion
152	+
153	+	CUpTime.Init
154	+
155	+	If CUpTime.isWin9x Then
156	+	x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
157	+	End
158	+	End If
159	+
160		''''TEMP
161	<	filterManagerHostname = "killigrew.ukc.ac.uk"
162	<	filterManagerTCPPort = 4567
163	<	Exit Sub
138	<	''' ENDTEMP
161	>	'filterManagerHostname = "killigrew.ukc.ac.uk"
162	>	'filterManagerTCPPort = 4567
163	>	''''' END TEMP
164
165	+	'GoTo skip
166		On Error GoTo iniError
167		Dim buf As String * 256
168		Dim length As Long
169	<	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
169	>	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
170		filterManagerHostname = Left$(buf, length)
171	<	length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
172	<	filterManagerTCPPort = Left$(buf, length)
171	>	length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
172	>	filterManagerTCPPort = length
173	>	If filterManagerHostname = "" Then
174	>	GoTo iniError
175	>	End If
176	>	On Error GoTo 0
177	>	skip:
178	>
179	>	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
180	>	Reconfigure_Click
181
182	+	SystemTray.Icon = Val(Form1.Icon)
183	+	SystemTray.Action = 0
184	+
185	+
186		Exit Sub
187
188		iniError:
189	<	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")
189	>	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")
190		End
191
192		End Sub
193
194	+	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
195	+	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")
196	+	If x = 7 Then
197	+	Cancel = True
198	+	Else
199	+	SystemTray.Action = 2
200	+	End If
201	+
202	+	End Sub
203	+
204	+	Private Sub Hide_Click()
205	+	Form1.Visible = False
206	+	SystemTray.Icon = Val(Form1.Icon)
207	+	End Sub
208	+
209	+	Private Sub Reconfigure_Click()
210	+	' establish a TCP connection to a filtermanager
211	+	connected = False
212	+	TCPSock.Close
213	+	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
214	+	End Sub
215	+
216	+
217	+
218	+	Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
219	+
220	+	Form1.Visible = True
221	+	Form1.SetFocus
222	+
223	+	End Sub
224	+
225		Private Sub TCPSock_Connect()
226	<
227	<	responseNumber = 0
226	>
227	>	responseNumber = 0
228
229		' Send something as soon as we connect to the server.
230		If connected = False Then
#	Line 178 | Line 247 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
247		' Remove linefeeds and returns from the line.
248		response = Replace(response, Chr(13), "")
249		response = Replace(response, Chr(10), "")
250	<	Text4.Text = Text4.Text & vbCrLf & response
250	>	'Text4.Text = Text4.Text & vbCrLf & response
251
252		If connected = False Then
253		' Perform TCP configuration (1.1)
#	Line 197 | Line 266 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
266		TCPSock.SendData "UDPUpdateTime" & vbCrLf
267		Case 4:
268		If response = "ERROR" Then GoTo configError
269	+	UDPUpdateTime = response
270		TCPSock.SendData "TCPUpdateTime" & vbCrLf
271		Case 5:
272		If response = "ERROR" Then GoTo configError
273	+	TCPUpdateTime = response
274		TCPSock.SendData "ENDCONFIG" & vbCrLf
275		Case 6:
276		If Not response = "OK" Then GoTo configError
#	Line 223 | Line 294 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
294		connected = True
295		responseNumber = 0
296		TCPSock.Close
297	<	Text4.Text = Text4.Text & vbCrLf & "  <closed>"
298	<	x = MsgBox("got config okay")
297	>	'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
298	>	Status.Caption = "Configuration successful"
299	>	Label3.Caption = UDPUpdateTime
300	>	Label4.Caption = TCPUpdateTime
301	>	Timer1.Interval = 1000
302		End Select
303		Else
304		' Perform a heartbeat (1.1)
#	Line 245 | Line 319 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
319		Case 5:
320		If Not response = "OK" Then GoTo heartbeatError
321		TCPSock.Close
322	<	x = MsgBox("heartbeat sent okay.")
322	>	Status.Caption = "Heartbeat sent successfully."
323		End Select
324
325		End If
#	Line 254 | Line 328 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
328		Exit Sub
329
330		configError:
331	<	x = MsgBox("error doing configuration")
331	>	Status.Caption = "FAILED to get configuration"
332	>	Exit Sub
333		heartbeatError:
334	<	x = MsgBox("error doing configuration")
334	>	Status.Caption = "Heatbeat FAILED"
335	>	Exit Sub
336		End Sub
337
338	+	Private Sub Timer1_Timer()
339	+
340	+	Label3.Caption = Label3.Caption - 1
341	+	Label4.Caption = Label4.Caption - 1
342	+
343	+	Status.Caption = ""
344	+
345	+	If Label3.Caption < 1 Then
346	+
347	+	' prepare the contents of the XML packet.
348	+	seqNo = seqNo + 1
349	+	machineName = TCPSock.LocalHostName
350	+	LocalIP = TCPSock.LocalIP
351	+	packetDate = Date2Num()
352	+
353	+
354	+	Dim verinfo As OSVERSIONINFO
355	+	verinfo.dwOSVersionInfoSize = Len(verinfo)
356	+	ret% = GetVersionEx(verinfo)
357	+	If ret% = 0 Then
358	+	MsgBox "Error getting Windows version Information"
359	+	End
360	+	End If
361	+
362	+	osName = GetVersion()
363	+	osVersionMajor = verinfo.dwMajorVersion
364	+	osVersionMinor = verinfo.dwMinorVersion
365	+	osBuild = verinfo.dwBuildNumber
366	+
367	+	Dim sysinfo As SYSTEM_INFO
368	+	GetSystemInfo sysinfo
369	+	Select Case sysinfo.dwProcessorType
370	+	Case PROCESSOR_INTEL_386
371	+	processorType = "Intel 386"
372	+	Case PROCESSOR_INTEL_486
373	+	processorType = "Intel 486"
374	+	Case PROCESSOR_INTEL_PENTIUM
375	+	processorType = "Intel Pentium variant"
376	+	Case PROCESSOR_MIPS_R4000
377	+	processorType = "MIPS R4000"
378	+	Case PROCESSOR_ALPHA_21064
379	+	processorType = "DEC Alpha 21064"
380	+	Case Else
381	+	processorType = "(unknown)"
382	+	End Select
383	+
384	+	Dim memsts As MEMORYSTATUS
385	+	Dim memory&
386	+	GlobalMemoryStatus memsts
387	+	memory& = memsts.dwTotalPhys
388	+	memTotal = memory& \ 1024
389	+	memory& = memsts.dwAvailPhys
390	+	memFree = memory& \ 1024
391	+	memory& = memsts.dwTotalVirtual
392	+	swapTotal = memory& \ 1024
393	+	memory& = memsts.dwAvailVirtual
394	+	swapFree = memory& \ 1024
395	+
396	+	uptime = CUpTime.MilliSecs \ 1000
397	+
398	+	CUpTime.Capture
399	+	cpu_time = CUpTime.CPUTime
400	+	percent_idle = CUpTime.PercentIdle
401	+
402	+	' build the contents of the XML packet
403	+	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
404	+	"<os>" & _
405	+	"<name>" & osName & "</name>" & _
406	+	"<version>" & osVersionMajor & "</version>" & _
407	+	"<release>" & osBuild & "</release>" & _
408	+	"<platform>" & osName & "</platform>" & _
409	+	"<minor_version>" & osVersionMinor & "</minor_version>" & _
410	+	"<processor>" & processorType & "</processor>" & _
411	+	"<uptime>" & uptime & "</uptime>" & _
412	+	"</os>" & _
413	+	"<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
414	+	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
415	+	"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
416	+	"</packet>"
417	+	'Text4.Text = Text4.Text + xml
418	+
419	+	' Use the first winsock control to send a UDP packet.
420	+	UDPSock.RemoteHost = filterHostname
421	+	UDPSock.RemotePort = filterUDPPort
422	+	UDPSock.SendData xml
423	+	Status.Caption = "UDP packet sent"
424	+	Label3.Caption = UDPUpdateTime
425	+	End If
426	+
427	+	If Label4.Caption < 1 Then
428	+	' establish a TCP connection to a filter
429	+	TCPSock.Close
430	+	TCPSock.Connect filterHostname, filterTCPPort
431	+	Label4.Caption = TCPUpdateTime
432	+	End If
433	+
434	+	End Sub
435	+
436	+	Function Date2Num() As Long
437	+	Dim x As Long
438	+	x = DateDiff("s", "1-1-1970", Now)
439	+	Date2Num = x
440	+	End Function

Diff Legend

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