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.9 by pjm2, Fri Feb 23 11:30:25 2001 UTC vs.
Revision 1.26 by pjm2, Wed Feb 28 09:08:08 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    =   4905
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     =   4905
16	>	ScaleWidth      =   4710
17		ShowInTaskbar   =   0   'False
18	<	StartUpPosition =   3  'Windows Default
19	<	Begin VB.Timer Timer1
20	<	Left            =   3840
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.CommandButton Command3
29	<	Caption         =   "TCP to Filter"
30	<	Height          =   375
31	<	Left            =   3720
25	<	TabIndex        =   3
26	<	Top             =   2520
27	<	Width           =   1575
28	<	End
29	<	Begin VB.TextBox Text4
30	<	Height          =   1575
31	<	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
37	<	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 Window"
40		Height          =   375
41	<	Left            =   3360
42	<	TabIndex        =   1
43	<	Top             =   2040
44	<	Width           =   1935
41	>	Left            =   3120
42	>	TabIndex        =   6
43	>	Top             =   240
44	>	Width           =   1455
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            =   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
54	–	Begin VB.CommandButton Command1
55	–	Caption         =   "Send UDP"
56	–	Height          =   375
57	–	Left            =   4320
58	–	TabIndex        =   0
59	–	Top             =   1560
60	–	Width           =   975
61	–	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
#	Line 72 | Line 83 | Begin VB.Form Form1
83		Caption         =   "Next heartbeat:"
84		Height          =   255
85		Left            =   120
86	<	TabIndex        =   8
86	>	TabIndex        =   5
87		Top             =   480
88		Width           =   1455
89		End
#	Line 81 | Line 92 | Begin VB.Form Form1
92		Caption         =   "Next UDP packet:"
93		Height          =   255
94		Left            =   120
95	<	TabIndex        =   7
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        =   6
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        =   5
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 115 | 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 132 | Line 150 | Dim TCPUpdateTime As Integer
150
151		Dim protocolVersion As String
152		Dim connected As Boolean
135	–	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.
141	<	xml = "<packet></packet>"
159	>	Dim responseNumber As Integer
160
161	<	' Use the first winsock control to send a UDP packet.
144	<	UDPSock.RemoteHost = filterHostname
145	<	UDPSock.RemotePort = filterUDPPort
146	<	UDPSock.SendData xml
147	<	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	<	Private Sub Command2_Click()
166	<
167	<	' establish a TCP connection to a filtermanager
168	<	TCPSock.Close
169	<	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
165	>	If windowBig Then
166	>	Form1.Height = 1500
167	>	windowBig = False
168	>	Else
169	>	Form1.Height = 4350
170	>	windowBig = True
171	>	End If
172
173		End Sub
174
159	–	Private Sub Command3_Click()
160	–	' establish a TCP connection to a filter
161	–	TCPSock.Close
162	–	TCPSock.Connect filterHostname, filterTCPPort
163	–	End Sub
164	–
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
184	<	Status.Caption = "i-scream Winhost " & protocolVersion
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	<	Exit Sub
174	<	''' 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 = "i-scream Winhost " & protocolVersion & " 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
229
230	+	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
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
237	+
238	+	End Sub
239	+
240	+	Private Sub Hide_Click()
241	+	Form1.Visible = False
242	+	SystemTray.Icon = Val(Form1.Icon)
243	+	End Sub
244	+
245	+	Private Sub Reconfigure_Click()
246	+	' establish a TCP connection to a filtermanager
247	+	connected = False
248	+	TCPSock.Close
249	+	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
250	+	End Sub
251	+
252	+
253	+
254	+	Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
255	+
256	+	Form1.Visible = True
257	+	Form1.SetFocus
258	+
259	+	End Sub
260	+
261		Private Sub TCPSock_Connect()
262
263		responseNumber = 0
#	Line 216 | 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), "")
286	<	Text4.Text = Text4.Text & vbCrLf & response
286	>	'Text4.Text = Text4.Text & vbCrLf & response
287
288		If connected = False Then
289		' Perform TCP configuration (1.1)
#	Line 225 | Line 292 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
292		Case 1:
293		If Not response = "OK" Then GoTo configError
294		TCPSock.SendData "LASTMODIFIED" & vbCrLf
295	+	Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
296	+	Text1.Text = Text1.Text & response & vbCrLf
297		Case 2:
298		If response = "ERROR" Then GoTo configError
299		lastModified = response
300	+	Text1.Text = Text1.Text & response & vbCrLf
301		TCPSock.SendData "FILELIST" & vbCrLf
302	+	''' Uncomment this for new protocol release.
303	+	'Case 2a:
304	+	'If response = "ERROR" Then GoTo configError
305	+	'fileList = response
306	+	'Text1.Text = Text1.Text & response & vbCrLf
307	+	'TCPSock.SendData "FQDN" & vbCrLf
308		Case 3:
309		If response = "ERROR" Then GoTo configError
310		fileList = response
311	+	Text1.Text = Text1.Text & response & vbCrLf
312	+	' REMOVE above line, uncomment next
313	+	'machineName = response
314		TCPSock.SendData "UDPUpdateTime" & vbCrLf
315		Case 4:
316		If response = "ERROR" Then GoTo configError
317		UDPUpdateTime = response
318	+	Text1.Text = Text1.Text & response & vbCrLf
319		TCPSock.SendData "TCPUpdateTime" & vbCrLf
320		Case 5:
321		If response = "ERROR" Then GoTo configError
322		TCPUpdateTime = response
323	+	Text1.Text = Text1.Text & response & vbCrLf
324		TCPSock.SendData "ENDCONFIG" & vbCrLf
325		Case 6:
326		If Not response = "OK" Then GoTo configError
327	+	Text1.Text = Text1.Text & response & vbCrLf
328		TCPSock.SendData "FILTER" & vbCrLf
329		Case 7:
330	+	Text1.Text = Text1.Text & response & vbCrLf
331		'we got a filter list here.
332		readTo = 0
333		' get hostname
#	Line 263 | Line 346 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
346		connected = True
347		responseNumber = 0
348		TCPSock.Close
349	<	Text4.Text = Text4.Text & vbCrLf & "  <closed>"
350	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
349	>	Text1.Text = Text1.Text & response & vbCrLf
350	>	'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
351	>	Status.Caption = "Configuration successful"
352		Label3.Caption = UDPUpdateTime
353		Label4.Caption = TCPUpdateTime
354		Timer1.Interval = 1000
#	Line 275 | Line 359 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
359		Select Case responseNumber
360		Case 1:
361		If Not response = "OK" Then GoTo heartbeatError
362	+	Text1.Text = "Performing heartbeat: -" & vbCrLf
363	+	Text1.Text = Text1.Text & response & vbCrLf
364		TCPSock.SendData "CONFIG" & vbCrLf
365		Case 2:
366		If Not response = "OK" Then GoTo heartbeatError
367	+	Text1.Text = Text1.Text & response & vbCrLf
368		TCPSock.SendData fileList & vbCrLf
369		Case 3:
370		If Not response = "OK" Then GoTo heartbeatError
371	+	Text1.Text = Text1.Text & response & vbCrLf
372		TCPSock.SendData lastModified & vbCrLf
373		Case 4:
374		If Not response = "OK" Then GoTo heartbeatError
375	+	Text1.Text = Text1.Text & response & vbCrLf
376		TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
377		Case 5:
378		If Not response = "OK" Then GoTo heartbeatError
379	+	Text1.Text = Text1.Text & response & vbCrLf
380		TCPSock.Close
381	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
381	>	Status.Caption = "Heartbeat sent successfully."
382		End Select
383
384		End If
#	Line 297 | Line 387 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
387		Exit Sub
388
389		configError:
390	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
390	>	Status.Caption = "FAILED to get configuration"
391		Exit Sub
392		heartbeatError:
393	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
393	>	Status.Caption = "Heatbeat FAILED"
394		Exit Sub
395		End Sub
396
307	–	Private Sub TCPTimer_Timer()
308	–
309	–	' establish a TCP connection to a filter
310	–	TCPSock.Close
311	–	TCPSock.Connect filterHostname, filterTCPPort
312	–
313	–	End Sub
314	–
315	–	Private Sub UDPTimer_Timer()
316	–
317	–	' build the contents of the XML packet.
318	–	xml = "<packet></packet>"
319	–
320	–	' Use the first winsock control to send a UDP packet.
321	–	UDPSock.RemoteHost = filterHostname
322	–	UDPSock.RemotePort = filterUDPPort
323	–	UDPSock.SendData xml
324	–	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
325	–
326	–	End Sub
327	–
397		Private Sub Timer1_Timer()
398
399		Label3.Caption = Label3.Caption - 1
400		Label4.Caption = Label4.Caption - 1
401
402	<	Status.Caption = "i-scream Winhost " & protocolVersion
402	>	Status.Caption = ""
403
404		If Label3.Caption < 1 Then
405	<	' build the contents of the XML packet.
406	<	xml = "<packet></packet>"
405	>
406	>	' prepare the contents of the XML packet.
407	>	seqNo = seqNo + 1
408	>
409	>	' Comment this line in the next protocol
410	>	machineName = TCPSock.LocalHostName
411	>
412	>	LocalIP = TCPSock.LocalIP
413	>	packetDate = Date2Num()
414	>
415	>
416	>	Dim verinfo As OSVERSIONINFO
417	>	verinfo.dwOSVersionInfoSize = Len(verinfo)
418	>	ret% = GetVersionEx(verinfo)
419	>	If ret% = 0 Then
420	>	MsgBox "Error getting Windows version Information"
421	>	End
422	>	End If
423	>
424	>	osName = GetVersion()
425	>	osVersionMajor = verinfo.dwMajorVersion
426	>	osVersionMinor = verinfo.dwMinorVersion
427	>	osBuild = verinfo.dwBuildNumber
428	>
429	>	Dim sysinfo As SYSTEM_INFO
430	>	GetSystemInfo sysinfo
431	>	Select Case sysinfo.dwProcessorType
432	>	Case PROCESSOR_INTEL_386
433	>	processorType = "Intel 386"
434	>	Case PROCESSOR_INTEL_486
435	>	processorType = "Intel 486"
436	>	Case PROCESSOR_INTEL_PENTIUM
437	>	processorType = "Intel Pentium variant"
438	>	Case PROCESSOR_MIPS_R4000
439	>	processorType = "MIPS R4000"
440	>	Case PROCESSOR_ALPHA_21064
441	>	processorType = "DEC Alpha 21064"
442	>	Case Else
443	>	processorType = "(unknown)"
444	>	End Select
445	>
446	>	Dim memsts As MEMORYSTATUS
447	>	Dim memory&
448	>	GlobalMemoryStatus memsts
449	>	memory& = memsts.dwTotalPhys
450	>	memTotal = memory& \ 1024
451	>	memory& = memsts.dwAvailPhys
452	>	memFree = memory& \ 1024
453	>	memory& = memsts.dwTotalVirtual
454	>	swapTotal = memory& \ 1024
455	>	memory& = memsts.dwAvailVirtual
456	>	swapFree = memory& \ 1024
457	>
458	>	uptime = CUpTime.MilliSecs \ 1000
459	>
460	>	CUpTime.Capture
461	>	cpu_time = CUpTime.CPUTime
462	>	percent_idle = CUpTime.PercentIdle
463	>
464	>	' build the contents of the XML packet
465	>	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
466	>	"<os>" & _
467	>	"<name>" & osName & "</name>" & _
468	>	"<version>" & osVersionMajor & "</version>" & _
469	>	"<release>" & osBuild & "</release>" & _
470	>	"<platform>" & osName & "</platform>" & _
471	>	"<minor_version>" & osVersionMinor & "</minor_version>" & _
472	>	"<processor>" & processorType & "</processor>" & _
473	>	"<uptime>" & uptime & "</uptime>" & _
474	>	"</os>" & _
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
483		UDPSock.RemotePort = filterUDPPort
484		UDPSock.SendData xml
485	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
485	>	Status.Caption = "UDP packet sent"
486		Label3.Caption = UDPUpdateTime
487		End If
488
#	Line 352 | 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