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

Diff Legend

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