ViewVC Help

View File | Revision Log | Show Annotations | Revision Graph | Root Listing

root/i-scream/experimental/host/vb_net_test/nettest.frm

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

Diff Legend

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