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

Diff Legend

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