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.16 by pjm2, Fri Feb 23 17:31:44 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"
5	>	BorderStyle     =   4  'Fixed ToolWindow
6	>	Caption         =   "i-scream Winhost"
7		ClientHeight    =   5655
8		ClientLeft      =   45
9	<	ClientTop       =   330
10	<	ClientWidth     =   5670
9	>	ClientTop       =   285
10	>	ClientWidth     =   4710
11		LinkTopic       =   "Form1"
12		MaxButton       =   0   'False
12	–	MinButton       =   0   'False
13		ScaleHeight     =   5655
14	<	ScaleWidth      =   5670
14	>	ScaleWidth      =   4710
15		ShowInTaskbar   =   0   'False
16		StartUpPosition =   3  'Windows Default
17	<	Begin VB.Timer Timer1
18	<	Left            =   3840
19	<	Top             =   120
20	<	End
21	<	Begin VB.CommandButton Command3
22	<	Caption         =   "TCP to Filter"
17	>	Begin VB.CommandButton Hide
18	>	Caption         =   "Hide Window"
19		Height          =   375
20	<	Left            =   3720
21	<	TabIndex        =   3
22	<	Top             =   2520
23	<	Width           =   1575
20	>	Left            =   3120
21	>	TabIndex        =   7
22	>	Top             =   840
23	>	Width           =   1455
24		End
25	+	Begin SysTray.SystemTray SystemTray
26	+	Left            =   2160
27	+	Top             =   1800
28	+	_ExtentX        =   847
29	+	_ExtentY        =   847
30	+	SysTrayText     =   "i-scream Winhost"
31	+	IconFile        =   0
32	+	End
33	+	Begin VB.Timer Timer1
34	+	Left            =   2760
35	+	Top             =   1800
36	+	End
37		Begin VB.TextBox Text4
38		Height          =   1575
39		Left            =   240
40		MultiLine       =   -1  'True
41		ScrollBars      =   2  'Vertical
42	<	TabIndex        =   2
42	>	TabIndex        =   1
43		Text            =   "nettest.frx":0000
44		Top             =   3000
45	<	Width           =   5055
45	>	Width           =   3975
46		End
47	<	Begin VB.CommandButton Command2
48	<	Caption         =   "TCP to FilterManager"
47	>	Begin VB.CommandButton Reconfigure
48	>	Caption         =   "Reconfigure with FilterManager"
49		Height          =   375
50	<	Left            =   3360
51	<	TabIndex        =   1
52	<	Top             =   2040
53	<	Width           =   1935
50	>	Left            =   120
51	>	TabIndex        =   0
52	>	Top             =   840
53	>	Width           =   2895
54		End
55		Begin MSWinsockLib.Winsock TCPSock
56	<	Left            =   4920
57	<	Top             =   120
56	>	Left            =   3720
57	>	Top             =   1800
58		_ExtentX        =   741
59		_ExtentY        =   741
60		_Version        =   393216
61		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
62		Begin MSWinsockLib.Winsock UDPSock
63	<	Left            =   4320
64	<	Top             =   120
63	>	Left            =   3240
64	>	Top             =   1800
65		_ExtentX        =   741
66		_ExtentY        =   741
67		_Version        =   393216
#	Line 71 | Line 71 | Begin VB.Form Form1
71		Alignment       =   1  'Right Justify
72		Caption         =   "Next heartbeat:"
73		Height          =   255
74	<	Left            =   120
75	<	TabIndex        =   8
74	>	Left            =   2400
75	>	TabIndex        =   6
76		Top             =   480
77		Width           =   1455
78		End
#	Line 80 | Line 80 | Begin VB.Form Form1
80		Alignment       =   1  'Right Justify
81		Caption         =   "Next UDP packet:"
82		Height          =   255
83	<	Left            =   120
84	<	TabIndex        =   7
83	>	Left            =   2400
84	>	TabIndex        =   5
85		Top             =   120
86		Width           =   1455
87		End
88		Begin VB.Label Label4
89	+	BorderStyle     =   1  'Fixed Single
90		Caption         =   "0"
91		Height          =   255
92	<	Left            =   1680
93	<	TabIndex        =   6
92	>	Left            =   3960
93	>	TabIndex        =   4
94		Top             =   480
95		Width           =   615
96		End
97		Begin VB.Label Label3
98	+	BorderStyle     =   1  'Fixed Single
99		Caption         =   "0"
100		Height          =   255
101	<	Left            =   1680
102	<	TabIndex        =   5
101	>	Left            =   3960
102	>	TabIndex        =   3
103		Top             =   120
104		Width           =   615
105		End
106		Begin VB.Label Status
107	+	Alignment       =   2  'Center
108		Caption         =   "Status:"
109		Height          =   255
110		Left            =   120
111	<	TabIndex        =   4
112	<	Top             =   5280
113	<	Width           =   5415
111	>	TabIndex        =   2
112	>	Top             =   1320
113	>	Width           =   4455
114		End
115		End
116		Attribute VB_Name = "Form1"
#	Line 115 | Line 118 | Attribute VB_GlobalNameSpace = False
118		Attribute VB_Creatable = False
119		Attribute VB_PredeclaredId = True
120		Attribute VB_Exposed = False
121	+	' For the system tray bits
122		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
123		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
124
125		Dim filterManagerHostname As String
126		Dim filterManagerTCPPort As Integer
127
128	+	Dim seqNo As Long
129	+	Dim machineName As String
130	+
131		Dim filterHostname As String
132		Dim filterTCPPort As Integer
133		Dim filterUDPPort As Integer
#	Line 132 | Line 139 | Dim TCPUpdateTime As Integer
139
140		Dim protocolVersion As String
141		Dim connected As Boolean
135	–	Dim responseNumber As Integer
142
143	+	'Dim CUpTime As New CUpTime
144
145	<	Private Sub Command1_Click()
145	>	Dim responseNumber As Integer
146
140	–	' build the contents of the XML packet.
141	–	xml = "<packet></packet>"
142	–
143	–	' 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."
148	–
149	–	End Sub
150	–
151	–	Private Sub Command2_Click()
152	–
153	–	' establish a TCP connection to a filtermanager
154	–	TCPSock.Close
155	–	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
156	–
157	–	End Sub
158	–
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	–
147		Private Sub Form_Load()
148	+
149		protocolVersion = "1.1"
150
151	<	Status.Caption = "i-scream Winhost " & protocolVersion
151	>	Status.Caption = "Loading"
152	>	'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
153
154		''''TEMP
155		filterManagerHostname = "killigrew.ukc.ac.uk"
156		filterManagerTCPPort = 4567
157	<	Exit Sub
174	<	''' ENDTEMP
157	>	''''' END TEMP
158
159	+	GoTo skip
160		On Error GoTo iniError
161		Dim buf As String * 256
162		Dim length As Long
#	Line 180 | Line 164 | Private Sub Form_Load()
164		filterManagerHostname = Left$(buf, length)
165		length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
166		filterManagerTCPPort = Left$(buf, length)
167	+	skip:
168	+
169	+	Status.Caption = "Connecting to Filter Manager"
170	+	Reconfigure_Click
171
172	<	Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
172	>	Form1.Show
173	>	SystemTray.Action = 0
174
175	+
176		Exit Sub
177
178		iniError:
#	Line 191 | Line 181 | iniError:
181
182		End Sub
183
184	+	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
185	+	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")
186	+	If x = 7 Then
187	+	Cancel = True
188	+	Else
189	+	SystemTray.Action = 2
190	+	End If
191	+
192	+	End Sub
193	+
194	+	Private Sub Hide_Click()
195	+	Form1.Visible = False
196	+	SystemTray.Icon = Val(Form1.Icon)
197	+	End Sub
198	+
199	+	Private Sub Reconfigure_Click()
200	+	' establish a TCP connection to a filtermanager
201	+	connected = False
202	+	TCPSock.Close
203	+	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
204	+	End Sub
205	+
206	+
207	+
208	+	Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
209	+
210	+	Form1.Visible = True
211	+	Form1.SetFocus
212	+
213	+
214	+	End Sub
215	+
216		Private Sub TCPSock_Connect()
217
218		responseNumber = 0
#	Line 264 | Line 286 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
286		responseNumber = 0
287		TCPSock.Close
288		Text4.Text = Text4.Text & vbCrLf & "  <closed>"
289	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
289	>	Status.Caption = "Configuration successful"
290		Label3.Caption = UDPUpdateTime
291		Label4.Caption = TCPUpdateTime
292		Timer1.Interval = 1000
#	Line 288 | Line 310 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
310		Case 5:
311		If Not response = "OK" Then GoTo heartbeatError
312		TCPSock.Close
313	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
313	>	Status.Caption = "Heartbeat sent successfully."
314		End Select
315
316		End If
#	Line 297 | Line 319 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
319		Exit Sub
320
321		configError:
322	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
322	>	Status.Caption = "FAILED to get configuration"
323		Exit Sub
324		heartbeatError:
325	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
325	>	Status.Caption = "Heatbeat FAILED"
326		Exit Sub
327		End Sub
328
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	–
329		Private Sub Timer1_Timer()
330
331		Label3.Caption = Label3.Caption - 1
332		Label4.Caption = Label4.Caption - 1
333
334	<	Status.Caption = "i-scream Winhost " & protocolVersion
334	>	Status.Caption = ""
335
336		If Label3.Caption < 1 Then
337	<	' build the contents of the XML packet.
338	<	xml = "<packet></packet>"
337	>
338	>	' prepare the contents of the XML packet.
339	>	seqNo = seqNo + 1
340	>	machineName = TCPSock.LocalHostName
341	>	LocalIP = TCPSock.LocalIP
342	>	packetDate = Date2Num()
343	>
344	>
345	>	Dim verinfo As OSVERSIONINFO
346	>	verinfo.dwOSVersionInfoSize = Len(verinfo)
347	>	ret% = GetVersionEx(verinfo)
348	>	If ret% = 0 Then
349	>	MsgBox "Error getting Windows version Information"
350	>	End
351	>	End If
352	>
353	>	osName = getVersion()
354	>	osVersionMajor = verinfo.dwMajorVersion
355	>	osVersionMinor = verinfo.dwMinorVersion
356	>	osBuild = verinfo.dwBuildNumber
357	>
358	>	Dim sysinfo As SYSTEM_INFO
359	>	GetSystemInfo sysinfo
360	>	Select Case sysinfo.dwProcessorType
361	>	Case PROCESSOR_INTEL_386
362	>	processorType = "Intel 386"
363	>	Case PROCESSOR_INTEL_486
364	>	processorType = "Intel 486"
365	>	Case PROCESSOR_INTEL_PENTIUM
366	>	processorType = "Intel Pentium variant"
367	>	Case PROCESSOR_MIPS_R4000
368	>	processorType = "MIPS R4000"
369	>	Case PROCESSOR_ALPHA_21064
370	>	processorType = "DEC Alpha 21064"
371	>	Case Else
372	>	processorType = "(unknown)"
373	>	End Select
374	>
375	>	Dim memsts As MEMORYSTATUS
376	>	Dim memory&
377	>	GlobalMemoryStatus memsts
378	>	memory& = memsts.dwTotalPhys
379	>	memTotal = memory& \ 1024
380	>	memory& = memsts.dwAvailPhys
381	>	memFree = memory& \ 1024
382	>	memory& = memsts.dwTotalVirtual
383	>	swapTotal = memory& \ 1024
384	>	memory& = memsts.dwAvailVirtual
385	>	swapFree = memory& \ 1024
386	>
387	>	' build the contents of the XML packet
388	>	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
389	>	"<os>" & _
390	>	"<name>" & osName & "</name>" & _
391	>	"<version>" & osVersionMajor & "</version>" & _
392	>	"<release>" & osBuild & "</release>" & _
393	>	"<platform>" & osName & "</platform>" & _
394	>	"<minor_version>" & osVersionMinor & "</minor_version>" & _
395	>	"<processor>" & processorType & "</processor>" & _
396	>	"</os>" & _
397	>	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
398	>	"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
399	>	""
400	>	Text4.Text = Text4.Text + xml
401
402		' Use the first winsock control to send a UDP packet.
403		UDPSock.RemoteHost = filterHostname
404		UDPSock.RemotePort = filterUDPPort
405		UDPSock.SendData xml
406	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
406	>	Status.Caption = "UDP packet sent"
407		Label3.Caption = UDPUpdateTime
408		End If
409
#	Line 352 | Line 415 | Private Sub Timer1_Timer()
415		End If
416
417		End Sub
418	+
419	+	Function Date2Num() As Long
420	+	Dim x As Long
421	+	x = DateDiff("s", "1-1-1970", Now)
422	+	Date2Num = x
423	+	End Function

Diff Legend

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