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.8 by pjm2, Fri Feb 23 11:25:35 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.Timer Timer1
20	<	Left            =   3840
19	<	Top             =   120
20	<	End
21	<	Begin VB.CommandButton Command3
22	<	Caption         =   "TCP to Filter"
19	>	Begin VB.CommandButton Hide
20	>	Caption         =   "Hide Window"
21		Height          =   375
22	<	Left            =   3720
23	<	TabIndex        =   3
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          =   1575
41		Left            =   240
42		MultiLine       =   -1  'True
43		ScrollBars      =   2  'Vertical
44	<	TabIndex        =   2
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        =   1
54	<	Top             =   2040
55	<	Width           =   1935
52	>	Left            =   120
53	>	TabIndex        =   0
54	>	Top             =   840
55	>	Width           =   2895
56		End
57		Begin MSWinsockLib.Winsock TCPSock
58	<	Left            =   4920
59	<	Top             =   120
58	>	Left            =   3720
59	>	Top             =   1800
60		_ExtentX        =   741
61		_ExtentY        =   741
62		_Version        =   393216
63		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
64		Begin MSWinsockLib.Winsock UDPSock
65	<	Left            =   4320
66	<	Top             =   120
65	>	Left            =   3240
66	>	Top             =   1800
67		_ExtentX        =   741
68		_ExtentY        =   741
69		_Version        =   393216
70		Protocol        =   1
71		End
72	<	Begin VB.Label Label4
73	<	Caption         =   "Label4"
74	<	Height          =   255
75	<	Left            =   1920
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             =   1320
87	<	Width           =   615
86	>	Top             =   120
87	>	Width           =   1815
88		End
78	–	Begin VB.Label Label3
79	–	Caption         =   "Label3"
80	–	Height          =   255
81	–	Left            =   1920
82	–	TabIndex        =   7
83	–	Top             =   960
84	–	Width           =   615
85	–	End
89		Begin VB.Label Label2
90	<	Caption         =   "Label2"
90	>	Alignment       =   1  'Right Justify
91	>	Caption         =   "Next heartbeat:"
92		Height          =   255
93	<	Left            =   120
93	>	Left            =   2400
94		TabIndex        =   6
95	<	Top             =   600
96	<	Width           =   3375
95	>	Top             =   480
96	>	Width           =   1455
97		End
98		Begin VB.Label Label1
99	<	Caption         =   "Label1"
99	>	Alignment       =   1  'Right Justify
100	>	Caption         =   "Next UDP packet:"
101		Height          =   255
102	<	Left            =   120
102	>	Left            =   2400
103		TabIndex        =   5
104	<	Top             =   240
105	<	Width           =   3375
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             =   480
114	+	Width           =   615
115	+	End
116	+	Begin VB.Label Label3
117	+	BorderStyle     =   1  'Fixed Single
118	+	Caption         =   "0"
119	+	Height          =   255
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            =   120
130	<	TabIndex        =   4
131	<	Top             =   5280
132	<	Width           =   5415
129	>	Left            =   0
130	>	TabIndex        =   2
131	>	Top             =   1320
132	>	Width           =   4695
133		End
134		End
135		Attribute VB_Name = "Form1"
#	Line 113 | Line 137 | 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 Integer
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
#	Line 130 | Line 158 | Dim TCPUpdateTime As Integer
158
159		Dim protocolVersion As String
160		Dim connected As Boolean
133	–	Dim responseNumber As Integer
161
162	+	Dim CUpTime As New CUpTime
163
164	<	Private Sub Command1_Click()
164	>	Dim responseNumber As Integer
165
138	–	' build the contents of the XML packet.
139	–	xml = "<packet></packet>"
140	–
141	–	' Use the first winsock control to send a UDP packet.
142	–	UDPSock.RemoteHost = filterHostname
143	–	UDPSock.RemotePort = filterUDPPort
144	–	UDPSock.SendData xml
145	–	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
146	–
147	–	End Sub
148	–
149	–	Private Sub Command2_Click()
150	–
151	–	' establish a TCP connection to a filtermanager
152	–	TCPSock.Close
153	–	TCPSock.Connect filterManagerHostname, filterManagerTCPPort
154	–
155	–	End Sub
156	–
157	–	Private Sub Command3_Click()
158	–	' establish a TCP connection to a filter
159	–	TCPSock.Close
160	–	TCPSock.Connect filterHostname, filterTCPPort
161	–	End Sub
162	–
166		Private Sub Form_Load()
167	+
168		protocolVersion = "1.1"
169
170	<	Status.Caption = "i-scream Winhost " & protocolVersion
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	<	Exit Sub
172	<	''' ENDTEMP
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")
191	>	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
192		filterManagerHostname = Left$(buf, length)
193	<	length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
194	<	filterManagerTCPPort = 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	>	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
199	>	Reconfigure_Click
200
201	<	Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
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.", 48, "Configuration not found")
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	+	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 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	+
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 TCPSock_Connect()
246
247		responseNumber = 0
#	Line 262 | Line 315 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
315		responseNumber = 0
316		TCPSock.Close
317		Text4.Text = Text4.Text & vbCrLf & "  <closed>"
318	<	Label1.Caption = "TCP hearbeat interval: " & UDPUpdateTime
266	<	Label2.Caption = "UDP packet interval: " & TCPUpdateTime
267	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
318	>	Status.Caption = "Configuration successful"
319		Label3.Caption = UDPUpdateTime
320		Label4.Caption = TCPUpdateTime
321		Timer1.Interval = 1000
#	Line 288 | Line 339 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
339		Case 5:
340		If Not response = "OK" Then GoTo heartbeatError
341		TCPSock.Close
342	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
342	>	Status.Caption = "Heartbeat sent successfully."
343		End Select
344
345		End If
#	Line 297 | Line 348 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
348		Exit Sub
349
350		configError:
351	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
351	>	Status.Caption = "FAILED to get configuration"
352		Exit Sub
353		heartbeatError:
354	<	Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
354	>	Status.Caption = "Heatbeat FAILED"
355		Exit Sub
356		End Sub
357
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	–
358		Private Sub Timer1_Timer()
359
360		Label3.Caption = Label3.Caption - 1
361		Label4.Caption = Label4.Caption - 1
362
363	<	Status.Caption = "i-scream Winhost " & protocolVersion
363	>	Status.Caption = ""
364
365		If Label3.Caption < 1 Then
366	<	' build the contents of the XML packet.
367	<	xml = "<packet></packet>"
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 = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
438	>	Status.Caption = "UDP packet sent"
439		Label3.Caption = UDPUpdateTime
440		End If
441
#	Line 352 | Line 447 | Private Sub Timer1_Timer()
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