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.6 by pjm2, Fri Feb 23 10:53:30 2001 UTC vs.
Revision 1.15 by pjm2, Fri Feb 23 17:08:37 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.CommandButton Command3
18	<	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
50	–	Begin VB.CommandButton Command1
51	–	Caption         =   "Send UDP"
52	–	Height          =   375
53	–	Left            =   4320
54	–	TabIndex        =   0
55	–	Top             =   1560
56	–	Width           =   975
57	–	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
68		Protocol        =   1
69		End
70	+	Begin VB.Label Label2
71	+	Alignment       =   1  'Right Justify
72	+	Caption         =   "Next heartbeat:"
73	+	Height          =   255
74	+	Left            =   2400
75	+	TabIndex        =   6
76	+	Top             =   480
77	+	Width           =   1455
78	+	End
79	+	Begin VB.Label Label1
80	+	Alignment       =   1  'Right Justify
81	+	Caption         =   "Next UDP packet:"
82	+	Height          =   255
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            =   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            =   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 77 | 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
134		Dim fileList As String
135		Dim lastModified As String
136
137	+	Dim UDPUpdateTime As Integer
138	+	Dim TCPUpdateTime As Integer
139	+
140		Dim protocolVersion As String
141		Dim connected As Boolean
142		Dim responseNumber As Integer
143
96	–
97	–	Private Sub Command1_Click()
98	–
99	–	' build the contents of the XML packet.
100	–	xml = "<packet></packet>"
101	–
102	–	' Use the first winsock control to send a UDP packet.
103	–	UDPSock.RemoteHost = filterHostname
104	–	UDPSock.RemotePort = filterUDPPort
105	–	UDPSock.SendData xml
106	–	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
107	–
108	–	End Sub
109	–
110	–	Private Sub Command2_Click()
111	–
112	–	' establish a TCP connection to a filtermanager
113	–	TCPSock.Close
114	–	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
115	–
116	–	End Sub
117	–
118	–	Private Sub Command3_Click()
119	–	' establish a TCP connection to a filter
120	–	TCPSock.Close
121	–	TCPSock.Connect filterHostname, filterTCPPort
122	–	End Sub
123	–
144		Private Sub Form_Load()
145	+
146		protocolVersion = "1.1"
147
148	<	Status.Caption = "i-scream Winhost " & protocolVersion
148	>	Status.Caption = "Loading"
149	>	'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
150
151		''''TEMP
152		filterManagerHostname = "killigrew.ukc.ac.uk"
153		filterManagerTCPPort = 4567
154	<	Exit Sub
133	<	''' ENDTEMP
154	>	''''' END TEMP
155
156	+	GoTo skip
157		On Error GoTo iniError
158		Dim buf As String * 256
159		Dim length As Long
#	Line 139 | Line 161 | Private Sub Form_Load()
161		filterManagerHostname = Left$(buf, length)
162		length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
163		filterManagerTCPPort = Left$(buf, length)
164	+	skip:
165	+
166	+	Status.Caption = "Connecting to Filter Manager"
167	+	Reconfigure_Click
168
169	<	Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
169	>	Form1.Show
170	>	SystemTray.Action = 0
171
172	+
173		Exit Sub
174
175		iniError:
#	Line 150 | Line 178 | iniError:
178
179		End Sub
180
181	<	Private Sub Label1_Click()
181	>	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
182	>	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")
183	>	If x = 7 Then
184	>	Cancel = True
185	>	Else
186	>	SystemTray.Action = 2
187	>	End If
188
189		End Sub
190
191	+	Private Sub Hide_Click()
192	+	Form1.Visible = False
193	+	SystemTray.Icon = Val(Form1.Icon)
194	+	End Sub
195	+
196	+	Private Sub Reconfigure_Click()
197	+	' establish a TCP connection to a filtermanager
198	+	connected = False
199	+	TCPSock.Close
200	+	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
201	+	End Sub
202	+
203	+
204	+
205	+	Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
206	+
207	+	Form1.Visible = True
208	+	Form1.SetFocus
209	+
210	+
211	+	End Sub
212	+
213		Private Sub TCPSock_Connect()
214
215		responseNumber = 0
#	Line 198 | Line 254 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
254		TCPSock.SendData "UDPUpdateTime" & vbCrLf
255		Case 4:
256		If response = "ERROR" Then GoTo configError
257	+	UDPUpdateTime = response
258		TCPSock.SendData "TCPUpdateTime" & vbCrLf
259		Case 5:
260		If response = "ERROR" Then GoTo configError
261	+	TCPUpdateTime = response
262		TCPSock.SendData "ENDCONFIG" & vbCrLf
263		Case 6:
264		If Not response = "OK" Then GoTo configError
#	Line 225 | Line 283 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
283		responseNumber = 0
284		TCPSock.Close
285		Text4.Text = Text4.Text & vbCrLf & "  <closed>"
286	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
286	>	Status.Caption = "Configuration successful"
287	>	Label3.Caption = UDPUpdateTime
288	>	Label4.Caption = TCPUpdateTime
289	>	Timer1.Interval = 1000
290		End Select
291		Else
292		' Perform a heartbeat (1.1)
#	Line 246 | Line 307 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
307		Case 5:
308		If Not response = "OK" Then GoTo heartbeatError
309		TCPSock.Close
310	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
310	>	Status.Caption = "Heartbeat sent successfully."
311		End Select
312
313		End If
#	Line 255 | Line 316 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
316		Exit Sub
317
318		configError:
319	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration"
319	>	Status.Caption = "FAILED to get configuration"
320	>	Exit Sub
321		heartbeatError:
322	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED"
322	>	Status.Caption = "Heatbeat FAILED"
323	>	Exit Sub
324		End Sub
325
326	+	Private Sub Timer1_Timer()
327	+
328	+	Label3.Caption = Label3.Caption - 1
329	+	Label4.Caption = Label4.Caption - 1
330	+
331	+	Status.Caption = ""
332	+
333	+	If Label3.Caption < 1 Then
334	+
335	+	' prepare the contents of the XML packet.
336	+	seqNo = seqNo + 1
337	+	machineName = TCPSock.LocalHostName
338	+	localIP = TCPSock.localIP
339	+	packetDate = Date2Num()
340	+
341	+
342	+	Dim verinfo As OSVERSIONINFO
343	+	verinfo.dwOSVersionInfoSize = Len(verinfo)
344	+	ret% = GetVersionEx(verinfo)
345	+	If ret% = 0 Then
346	+	MsgBox "Error getting Windows version Information"
347	+	End
348	+	End If
349	+
350	+	osName = getVersion()
351	+	osVersionMajor = verinfo.dwMajorVersion
352	+	osVersionMinor = verinfo.dwMinorVersion
353	+	osBuild = verinfo.dwBuildNumber
354	+
355	+	Dim sysinfo As SYSTEM_INFO
356	+	GetSystemInfo sysinfo
357	+	Select Case sysinfo.dwProcessorType
358	+	Case PROCESSOR_INTEL_386
359	+	processorType = "Intel 386"
360	+	Case PROCESSOR_INTEL_486
361	+	processorType = "Intel 486"
362	+	Case PROCESSOR_INTEL_PENTIUM
363	+	processorType = "Intel Pentium variant"
364	+	Case PROCESSOR_MIPS_R4000
365	+	processorType = "MIPS R4000"
366	+	Case PROCESSOR_ALPHA_21064
367	+	processorType = "DEC Alpha 21064"
368	+	Case Else
369	+	processorType = "(unknown)"
370	+	End Select
371	+
372	+	Dim memsts As MEMORYSTATUS
373	+	Dim memory&
374	+	GlobalMemoryStatus memsts
375	+	memory& = memsts.dwTotalPhys
376	+	memTotal = memory& \ 1024
377	+	memory& = memsts.dwAvailPhys
378	+	memFree = memory& \ 1024
379	+	memory& = memsts.dwTotalVirtual
380	+	swapTotal = memory& \ 1024
381	+	memory& = memsts.dwAvailVirtual
382	+	swapFree = memory& \ 1024
383	+
384	+	' build the contents of the XML packet
385	+	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
386	+	"<os>" & _
387	+	"<name>" & osName & "</name>" & _
388	+	"<version>" & osVersionMajor & "</version>" & _
389	+	"<release>" & osBuild & "</release>" & _
390	+	"<platform>" & osName & "</platform>" & _
391	+	"<minor_version>" & osVersionMinor & "</minor_version>" & _
392	+	"<processor>" & processorType & "</processor>" & _
393	+	"</os>" & _
394	+	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
395	+	"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
396	+	""
397	+	Text4.Text = Text4.Text + xml
398	+
399	+	' Use the first winsock control to send a UDP packet.
400	+	UDPSock.RemoteHost = filterHostname
401	+	UDPSock.RemotePort = filterUDPPort
402	+	UDPSock.SendData xml
403	+	Status.Caption = "UDP packet sent"
404	+	Label3.Caption = UDPUpdateTime
405	+	End If
406	+
407	+	If Label4.Caption < 1 Then
408	+	' establish a TCP connection to a filter
409	+	TCPSock.Close
410	+	TCPSock.Connect filterHostname, filterTCPPort
411	+	Label4.Caption = TCPUpdateTime
412	+	End If
413	+
414	+	End Sub
415	+
416	+	Function Date2Num() As Long
417	+	Dim x As Long
418	+	x = DateDiff("s", "1-1-1970", Now)
419	+	Date2Num = x
420	+	End Function

Diff Legend

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