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.1 by pjm2, Thu Feb 22 17:04:22 2001 UTC vs.
Revision 1.21 by pjm2, Mon Feb 26 09:23:34 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        =   9
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        =   8
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        =   7
54	<	Top             =   2040
55	<	Width           =   1935
52	>	Left            =   120
53	>	TabIndex        =   0
54	>	Top             =   840
55	>	Width           =   2895
56		End
57	<	Begin MSWinsockLib.Winsock Winsock2
58	<	Left            =   4920
59	<	Top             =   120
57	>	Begin MSWinsockLib.Winsock TCPSock
58	>	Left            =   3720
59	>	Top             =   1800
60		_ExtentX        =   741
61		_ExtentY        =   741
62		_Version        =   393216
63		End
64	<	Begin VB.TextBox Text3
65	<	Height          =   285
66	<	Left            =   1680
53	<	TabIndex        =   5
54	<	Text            =   "killigrew.ukc.ac.uk"
55	<	Top             =   1560
56	<	Width           =   2535
57	<	End
58	<	Begin VB.TextBox Text2
59	<	Height          =   285
60	<	Left            =   1680
61	<	TabIndex        =   3
62	<	Text            =   "4567"
63	<	Top             =   1920
64	<	Width           =   855
65	<	End
66	<	Begin VB.CommandButton Command1
67	<	Caption         =   "Send UDP"
68	<	Height          =   375
69	<	Left            =   4320
70	<	TabIndex        =   2
71	<	Top             =   1560
72	<	Width           =   975
73	<	End
74	<	Begin VB.TextBox Text1
75	<	Height          =   855
76	<	Left            =   360
77	<	TabIndex        =   0
78	<	Text            =   "<packet></packet>"
79	<	Top             =   600
80	<	Width           =   4935
81	<	End
82	<	Begin MSWinsockLib.Winsock Winsock1
83	<	Left            =   4320
84	<	Top             =   120
64	>	Begin MSWinsockLib.Winsock UDPSock
65	>	Left            =   3240
66	>	Top             =   1800
67		_ExtentX        =   741
68		_ExtentY        =   741
69		_Version        =   393216
70		Protocol        =   1
71		End
72	<	Begin VB.Label Label3
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         =   "Destination:"
91	>	Caption         =   "Next heartbeat:"
92		Height          =   255
93	<	Left            =   360
93	>	Left            =   2400
94		TabIndex        =   6
95	<	Top             =   1560
96	<	Width           =   1215
95	>	Top             =   480
96	>	Width           =   1455
97		End
98	<	Begin VB.Label Label2
98	>	Begin VB.Label Label1
99		Alignment       =   1  'Right Justify
100	<	Caption         =   "Port:"
100	>	Caption         =   "Next UDP packet:"
101		Height          =   255
102	<	Left            =   360
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             =   1920
114	<	Width           =   1215
113	>	Top             =   480
114	>	Width           =   615
115		End
116	<	Begin VB.Label Label1
117	<	Caption         =   "Packet contents"
116	>	Begin VB.Label Label3
117	>	BorderStyle     =   1  'Fixed Single
118	>	Caption         =   "0"
119		Height          =   255
120	<	Left            =   360
121	<	TabIndex        =   1
122	<	Top             =   360
123	<	Width           =   2895
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 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
161	+
162	+	Dim CUpTime As New CUpTime
163	+
164		Dim responseNumber As Integer
165
166	+	Private Sub Form_Load()
167	+
168	+	protocolVersion = "1.1"
169	+
170	+	Status.Caption = "Loading"
171	+	Form1.Caption = "i-scream Winhost " & protocolVersion
172	+
173	+	Form1.Show
174	+
175	+	CUpTime.Init
176	+
177	+	If CUpTime.isWin9x Then
178	+	x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server.")
179	+	End
180	+	End If
181	+
182	+	''''TEMP
183	+	'filterManagerHostname = "killigrew.ukc.ac.uk"
184	+	'filterManagerTCPPort = 4567
185	+	''''' END TEMP
186	+
187	+	'GoTo skip
188	+	On Error GoTo iniError
189	+	Dim buf As String * 256
190	+	Dim length As Long
191	+	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
192	+	filterManagerHostname = Left$(buf, length)
193	+	length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
194	+	filterManagerTCPPort = length
195	+	On Error GoTo 0
196	+	skip:
197
198	<	Private Sub Command1_Click()
198	>	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
199	>	Reconfigure_Click
200	>
201	>	SystemTray.Icon = Val(Form1.Icon)
202	>	SystemTray.Action = 0
203	>
204	>
205	>	Exit Sub
206	>
207	>	iniError:
208	>	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")
209	>	End
210	>
211	>	End Sub
212
213	<	' Use the first winsock control to send
214	<	' a UDP packet.
215	<	Winsock1.RemoteHost = Text3.Text
216	<	Winsock1.RemotePort = Text2.Text
217	<	Winsock1.SendData Text1.Text
213	>	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
214	>	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")
215	>	If x = 7 Then
216	>	Cancel = True
217	>	Else
218	>	SystemTray.Action = 2
219	>	End If
220
221		End Sub
222
223	<	Private Sub Command2_Click()
224	<
225	<	' establish a TCP connection to a machine
226	<	Winsock2.Close
139	<	Winsock2.Connect Text3.Text, Text2.Text
223	>	Private Sub Hide_Click()
224	>	Form1.Visible = False
225	>	SystemTray.Icon = Val(Form1.Icon)
226	>	End Sub
227
228	+	Private Sub Reconfigure_Click()
229	+	' establish a TCP connection to a filtermanager
230	+	connected = False
231	+	TCPSock.Close
232	+	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
233		End Sub
234
235	<	Private Sub Command3_Click()
236	<	x = MsgBox("not implemented..")
235	>
236	>
237	>	Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
238	>
239	>	Form1.Visible = True
240	>	Form1.SetFocus
241	>
242	>
243		End Sub
244
245	<	Private Sub Winsock2_Connect()
246	<
247	<	responseNumber = 0
245	>	Private Sub TCPSock_Connect()
246	>
247	>	responseNumber = 0
248
249	<	' As soon as we are connected to the server, send this.
250	<	Winsock2.SendData "STARTCONFIG" & vbCrLf
249	>	' Send something as soon as we connect to the server.
250	>	If connected = False Then
251	>	' contact the FilterManager
252	>	TCPSock.SendData "STARTCONFIG" & vbCrLf
253	>	Else
254	>	' Contact the Filter
255	>	TCPSock.SendData "HEARTBEAT" & vbCrLf
256	>	End If
257
258		End Sub
259
260	<	Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
260	>	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
261
262		responseNumber = responseNumber + 1
263
264		' Get the line from the server.
265	<	Winsock2.GetData response, vbString, bytesTotal
265	>	TCPSock.GetData response, vbString, bytesTotal
266
267		' Remove linefeeds and returns from the line.
268		response = Replace(response, Chr(13), "")
269		response = Replace(response, Chr(10), "")
270		Text4.Text = Text4.Text & vbCrLf & response
271
272	<	' Decide what to send back to the server.
273	<	Select Case responseNumber
274	<	Case 1:
275	<	Winsock2.SendData "LASTMODIFIED" & vbCrLf
276	<	Case 2:
277	<	Winsock2.SendData "FILELIST" & vbCrLf
278	<	Case 3:
279	<	Winsock2.SendData "UDPUpdateTime" & vbCrLf
280	<	Case 4:
281	<	Winsock2.SendData "TCPUpdateTime" & vbCrLf
282	<	Case 5:
283	<	Winsock2.SendData "ENDCONFIG" & vbCrLf
284	<	Case 6:
285	<	Winsock2.SendData "FILTER" & vbCrLf
286	<	Case 7:
287	<	Winsock2.SendData "END" & vbCrLf
288	<	Case 8:
289	<	Winsock2.Close
290	<	Text4.Text = Text4.Text & vbCrLf & "  <closed>"
291	<	End Select
272	>	If connected = False Then
273	>	' Perform TCP configuration (1.1)
274	>	On Error GoTo configError
275	>	Select Case responseNumber
276	>	Case 1:
277	>	If Not response = "OK" Then GoTo configError
278	>	TCPSock.SendData "LASTMODIFIED" & vbCrLf
279	>	Case 2:
280	>	If response = "ERROR" Then GoTo configError
281	>	lastModified = response
282	>	TCPSock.SendData "FILELIST" & vbCrLf
283	>	Case 3:
284	>	If response = "ERROR" Then GoTo configError
285	>	fileList = response
286	>	TCPSock.SendData "UDPUpdateTime" & vbCrLf
287	>	Case 4:
288	>	If response = "ERROR" Then GoTo configError
289	>	UDPUpdateTime = response
290	>	TCPSock.SendData "TCPUpdateTime" & vbCrLf
291	>	Case 5:
292	>	If response = "ERROR" Then GoTo configError
293	>	TCPUpdateTime = response
294	>	TCPSock.SendData "ENDCONFIG" & vbCrLf
295	>	Case 6:
296	>	If Not response = "OK" Then GoTo configError
297	>	TCPSock.SendData "FILTER" & vbCrLf
298	>	Case 7:
299	>	'we got a filter list here.
300	>	readTo = 0
301	>	' get hostname
302	>	readTo = InStr(1, response, ";", vbBinaryCompare)
303	>	filterHostname = Mid(response, 1, readTo - 1)
304	>	response = Mid(response, readTo + 1, Len(response))
305	>	' get UDP Port number
306	>	readTo = InStr(1, response, ";")
307	>	filterUDPPort = Mid(response, 1, readTo - 1)
308	>	response = Mid(response, readTo + 1, Len(response))
309	>	' get TCP Port number
310	>	filterTCPPort = response
311	>	TCPSock.SendData "END" & vbCrLf
312	>	Case 8:
313	>	If Not response = "OK" Then GoTo configError
314	>	connected = True
315	>	responseNumber = 0
316	>	TCPSock.Close
317	>	Text4.Text = Text4.Text & vbCrLf & "  <closed>"
318	>	Status.Caption = "Configuration successful"
319	>	Label3.Caption = UDPUpdateTime
320	>	Label4.Caption = TCPUpdateTime
321	>	Timer1.Interval = 1000
322	>	End Select
323	>	Else
324	>	' Perform a heartbeat (1.1)
325	>	On Error GoTo heartbeatError
326	>	Select Case responseNumber
327	>	Case 1:
328	>	If Not response = "OK" Then GoTo heartbeatError
329	>	TCPSock.SendData "CONFIG" & vbCrLf
330	>	Case 2:
331	>	If Not response = "OK" Then GoTo heartbeatError
332	>	TCPSock.SendData fileList & vbCrLf
333	>	Case 3:
334	>	If Not response = "OK" Then GoTo heartbeatError
335	>	TCPSock.SendData lastModified & vbCrLf
336	>	Case 4:
337	>	If Not response = "OK" Then GoTo heartbeatError
338	>	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
339	>	Case 5:
340	>	If Not response = "OK" Then GoTo heartbeatError
341	>	TCPSock.Close
342	>	Status.Caption = "Heartbeat sent successfully."
343	>	End Select
344
345	+	End If
346	+
347	+
348	+	Exit Sub
349	+
350	+	configError:
351	+	Status.Caption = "FAILED to get configuration"
352	+	Exit Sub
353	+	heartbeatError:
354	+	Status.Caption = "Heatbeat FAILED"
355	+	Exit Sub
356		End Sub
357	+
358	+	Private Sub Timer1_Timer()
359	+
360	+	Label3.Caption = Label3.Caption - 1
361	+	Label4.Caption = Label4.Caption - 1
362	+
363	+	Status.Caption = ""
364	+
365	+	If Label3.Caption < 1 Then
366	+
367	+	' prepare the contents of the XML packet.
368	+	seqNo = seqNo + 1
369	+	machineName = TCPSock.LocalHostName
370	+	LocalIP = TCPSock.LocalIP
371	+	packetDate = Date2Num()
372	+
373	+
374	+	Dim verinfo As OSVERSIONINFO
375	+	verinfo.dwOSVersionInfoSize = Len(verinfo)
376	+	ret% = GetVersionEx(verinfo)
377	+	If ret% = 0 Then
378	+	MsgBox "Error getting Windows version Information"
379	+	End
380	+	End If
381	+
382	+	osName = GetVersion()
383	+	osVersionMajor = verinfo.dwMajorVersion
384	+	osVersionMinor = verinfo.dwMinorVersion
385	+	osBuild = verinfo.dwBuildNumber
386	+
387	+	Dim sysinfo As SYSTEM_INFO
388	+	GetSystemInfo sysinfo
389	+	Select Case sysinfo.dwProcessorType
390	+	Case PROCESSOR_INTEL_386
391	+	processorType = "Intel 386"
392	+	Case PROCESSOR_INTEL_486
393	+	processorType = "Intel 486"
394	+	Case PROCESSOR_INTEL_PENTIUM
395	+	processorType = "Intel Pentium variant"
396	+	Case PROCESSOR_MIPS_R4000
397	+	processorType = "MIPS R4000"
398	+	Case PROCESSOR_ALPHA_21064
399	+	processorType = "DEC Alpha 21064"
400	+	Case Else
401	+	processorType = "(unknown)"
402	+	End Select
403	+
404	+	Dim memsts As MEMORYSTATUS
405	+	Dim memory&
406	+	GlobalMemoryStatus memsts
407	+	memory& = memsts.dwTotalPhys
408	+	memTotal = memory& \ 1024
409	+	memory& = memsts.dwAvailPhys
410	+	memFree = memory& \ 1024
411	+	memory& = memsts.dwTotalVirtual
412	+	swapTotal = memory& \ 1024
413	+	memory& = memsts.dwAvailVirtual
414	+	swapFree = memory& \ 1024
415	+
416	+	uptime = GetTickCount \ 1000
417	+
418	+	' build the contents of the XML packet
419	+	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
420	+	"<os>" & _
421	+	"<name>" & osName & "</name>" & _
422	+	"<version>" & osVersionMajor & "</version>" & _
423	+	"<release>" & osBuild & "</release>" & _
424	+	"<platform>" & osName & "</platform>" & _
425	+	"<minor_version>" & osVersionMinor & "</minor_version>" & _
426	+	"<processor>" & processorType & "</processor>" & _
427	+	"<uptime>" & uptime & "</uptime>" & _
428	+	"</os>" & _
429	+	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
430	+	"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
431	+	"</packet>"
432	+	Text4.Text = Text4.Text + xml
433	+
434	+	' Use the first winsock control to send a UDP packet.
435	+	UDPSock.RemoteHost = filterHostname
436	+	UDPSock.RemotePort = filterUDPPort
437	+	UDPSock.SendData xml
438	+	Status.Caption = "UDP packet sent"
439	+	Label3.Caption = UDPUpdateTime
440	+	End If
441	+
442	+	If Label4.Caption < 1 Then
443	+	' establish a TCP connection to a filter
444	+	TCPSock.Close
445	+	TCPSock.Connect filterHostname, filterTCPPort
446	+	Label4.Caption = TCPUpdateTime
447	+	End If
448	+
449	+	End Sub
450	+
451	+	Function Date2Num() As Long
452	+	Dim x As Long
453	+	x = DateDiff("s", "1-1-1970", Now)
454	+	Date2Num = x
455	+	End Function

Diff Legend

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