ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/winhost/nettest.frm
(Generate patch)

Comparing projects/cms/source/host/winhost/nettest.frm (file contents):
Revision 1.15 by pjm2, Fri Feb 23 17:08:37 2001 UTC vs.
Revision 1.36 by pjm2, Mon Mar 19 10:11:15 2001 UTC

# Line 2 | Line 2 | 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     =   4  'Fixed ToolWindow
5 >   BorderStyle     =   3  'Fixed Dialog
6     Caption         =   "i-scream Winhost"
7 <   ClientHeight    =   5655
7 >   ClientHeight    =   1185
8     ClientLeft      =   45
9 <   ClientTop       =   285
9 >   ClientTop       =   330
10     ClientWidth     =   4710
11 +   Icon            =   "nettest.frx":0000
12     LinkTopic       =   "Form1"
13     MaxButton       =   0   'False
14 <   ScaleHeight     =   5655
14 >   MinButton       =   0   'False
15 >   ScaleHeight     =   1185
16     ScaleWidth      =   4710
17     ShowInTaskbar   =   0   'False
18 <   StartUpPosition =   3  'Windows Default
19 <   Begin VB.CommandButton Hide
20 <      Caption         =   "Hide Window"
21 <      Height          =   375
22 <      Left            =   3120
23 <      TabIndex        =   7
18 >   StartUpPosition =   2  'CenterScreen
19 >   Visible         =   0   'False
20 >   Begin VB.CommandButton Command1
21 >      Caption         =   "more"
22 >      Height          =   255
23 >      Left            =   3960
24 >      TabIndex        =   8
25        Top             =   840
26 <      Width           =   1455
26 >      Width           =   615
27     End
28 +   Begin VB.TextBox Text1
29 +      Height          =   2055
30 +      Left            =   120
31 +      Locked          =   -1  'True
32 +      MultiLine       =   -1  'True
33 +      ScrollBars      =   2  'Vertical
34 +      TabIndex        =   7
35 +      Top             =   1200
36 +      Width           =   4455
37 +   End
38 +   Begin VB.CommandButton Hide
39 +      Caption         =   "hide"
40 +      Height          =   255
41 +      Left            =   3960
42 +      TabIndex        =   6
43 +      Top             =   480
44 +      Width           =   615
45 +   End
46     Begin SysTray.SystemTray SystemTray
47 <      Left            =   2160
48 <      Top             =   1800
47 >      Left            =   2520
48 >      Top             =   4200
49        _ExtentX        =   847
50        _ExtentY        =   847
51        SysTrayText     =   "i-scream Winhost"
52        IconFile        =   0
53     End
54     Begin VB.Timer Timer1
55 <      Left            =   2760
56 <      Top             =   1800
55 >      Left            =   3120
56 >      Top             =   4200
57     End
37 –   Begin VB.TextBox Text4
38 –      Height          =   1575
39 –      Left            =   240
40 –      MultiLine       =   -1  'True
41 –      ScrollBars      =   2  'Vertical
42 –      TabIndex        =   1
43 –      Text            =   "nettest.frx":0000
44 –      Top             =   3000
45 –      Width           =   3975
46 –   End
58     Begin VB.CommandButton Reconfigure
59        Caption         =   "Reconfigure with FilterManager"
60        Height          =   375
61 <      Left            =   120
61 >      Left            =   840
62        TabIndex        =   0
63 <      Top             =   840
63 >      Top             =   3480
64        Width           =   2895
65     End
66     Begin MSWinsockLib.Winsock TCPSock
67 <      Left            =   3720
68 <      Top             =   1800
67 >      Left            =   4080
68 >      Top             =   4200
69        _ExtentX        =   741
70        _ExtentY        =   741
71        _Version        =   393216
72     End
73     Begin MSWinsockLib.Winsock UDPSock
74 <      Left            =   3240
75 <      Top             =   1800
74 >      Left            =   3600
75 >      Top             =   4200
76        _ExtentX        =   741
77        _ExtentY        =   741
78        _Version        =   393216
# Line 71 | Line 82 | Begin VB.Form Form1
82        Alignment       =   1  'Right Justify
83        Caption         =   "Next heartbeat:"
84        Height          =   255
85 <      Left            =   2400
86 <      TabIndex        =   6
85 >      Left            =   120
86 >      TabIndex        =   5
87        Top             =   480
88        Width           =   1455
89     End
# Line 80 | Line 91 | Begin VB.Form Form1
91        Alignment       =   1  'Right Justify
92        Caption         =   "Next UDP packet:"
93        Height          =   255
94 <      Left            =   2400
95 <      TabIndex        =   5
94 >      Left            =   120
95 >      TabIndex        =   4
96        Top             =   120
97        Width           =   1455
98     End
# Line 89 | Line 100 | Begin VB.Form Form1
100        BorderStyle     =   1  'Fixed Single
101        Caption         =   "0"
102        Height          =   255
103 <      Left            =   3960
104 <      TabIndex        =   4
103 >      Left            =   1680
104 >      TabIndex        =   3
105        Top             =   480
106        Width           =   615
107     End
# Line 98 | Line 109 | Begin VB.Form Form1
109        BorderStyle     =   1  'Fixed Single
110        Caption         =   "0"
111        Height          =   255
112 <      Left            =   3960
113 <      TabIndex        =   3
112 >      Left            =   1680
113 >      TabIndex        =   2
114        Top             =   120
115        Width           =   615
116     End
# Line 107 | Line 118 | Begin VB.Form Form1
118        Alignment       =   2  'Center
119        Caption         =   "Status:"
120        Height          =   255
121 <      Left            =   120
122 <      TabIndex        =   2
123 <      Top             =   1320
124 <      Width           =   4455
121 >      Left            =   0
122 >      TabIndex        =   1
123 >      Top             =   840
124 >      Width           =   3855
125     End
126   End
127   Attribute VB_Name = "Form1"
# Line 123 | Line 134 | Private Declare Function GetPrivateProfileString Lib "
134   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
135  
136   Dim filterManagerHostname As String
137 < Dim filterManagerTCPPort As Integer
137 > Dim filterManagerTCPPort As Long
138  
139   Dim seqNo As Long
140   Dim machineName As String
141  
142 + Dim secondsRunning As Long
143 +
144   Dim filterHostname As String
145   Dim filterTCPPort As Integer
146   Dim filterUDPPort As Integer
147   Dim fileList As String
148   Dim lastModified As String
149  
150 + Dim fourtySevenDays As Integer
151 +
152   Dim UDPUpdateTime As Integer
153   Dim TCPUpdateTime As Integer
154  
155   Dim protocolVersion As String
156   Dim connected As Boolean
157 + Dim heartBeating As Boolean
158 +
159 + Dim CUpTime As New CUpTime
160 + Dim wksta As New CNetWksta
161 +
162 + Dim windowBig As Boolean
163 +
164   Dim responseNumber As Integer
165  
166 + Private Sub Command1_Click()
167 +
168 +    ' Toggle visibility of the debug output.
169 +
170 +    If windowBig Then
171 +        Form1.Height = 1500
172 +        windowBig = False
173 +    Else
174 +        Form1.Height = 4350
175 +        windowBig = True
176 +    End If
177 +
178 + End Sub
179 +
180   Private Sub Form_Load()
181      
182 +    If App.PrevInstance Then
183 +        x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
184 +        End
185 +    End If
186 +    
187 +    ' Assume the host is run within the first 47 days of the machine starting.
188 +    fourtySevenDays = 0
189 +    
190      protocolVersion = "1.1"
191      
192      Status.Caption = "Loading"
193 <    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
193 >    Form1.Caption = "i-scream Winhost " & protocolVersion
194      
195 +    CUpTime.Init
196 +    
197 +    If CUpTime.isWin9x Then
198 +        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
199 +        End
200 +    End If
201 +    
202 +    windowBig = False
203 +    
204      ''''TEMP
205 <    filterManagerHostname = "killigrew.ukc.ac.uk"
206 <    filterManagerTCPPort = 4567
205 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
206 >    'filterManagerTCPPort = 4567
207      ''''' END TEMP
208      
209 <    GoTo skip
209 >    'GoTo skip
210      On Error GoTo iniError
211      Dim buf As String * 256
212      Dim length As Long
213 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
213 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
214      filterManagerHostname = Left$(buf, length)
215 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
216 <    filterManagerTCPPort = Left$(buf, length)
215 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
216 >    filterManagerTCPPort = length
217 >    If filterManagerHostname = "" Then
218 >        GoTo iniError
219 >    End If
220 >    On Error GoTo 0
221   skip:
222  
223 <    Status.Caption = "Connecting to Filter Manager"
223 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
224      Reconfigure_Click
225      
226 <    Form1.Show
226 >    SystemTray.Icon = Val(Form1.Icon)
227      SystemTray.Action = 0
228      
229      
230      Exit Sub
231      
232   iniError:
233 <    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")
233 >    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")
234      End
235      
236   End Sub
# Line 193 | Line 250 | Private Sub Hide_Click()
250      SystemTray.Icon = Val(Form1.Icon)
251   End Sub
252  
253 +
254   Private Sub Reconfigure_Click()
255      ' establish a TCP connection to a filtermanager
256 <    connected = False
257 <    TCPSock.Close
258 <    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
256 >    If Not heartBeating Then
257 >        connected = False
258 >        TCPSock.Close
259 >        TCPSock.Connect filterManagerHostname, filterManagerTCPPort
260 >    Else
261 >        Status.Caption = "Cannot reconfigure while heartbeating"
262 >    End If
263   End Sub
264  
265  
# Line 206 | Line 268 | Private Sub SystemTray_MouseDblClk(ByVal Button As Int
268  
269      Form1.Visible = True
270      Form1.SetFocus
209 –    
271  
272   End Sub
273  
# Line 235 | Line 296 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
296      ' Remove linefeeds and returns from the line.
297      response = Replace(response, Chr(13), "")
298      response = Replace(response, Chr(10), "")
238 –    Text4.Text = Text4.Text & vbCrLf & response
299      
300      If connected = False Then
301          ' Perform TCP configuration (1.1)
# Line 244 | Line 304 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
304              Case 1:
305                  If Not response = "OK" Then GoTo configError
306                  TCPSock.SendData "LASTMODIFIED" & vbCrLf
307 +                Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
308 +                Text1.Text = Text1.Text & response & vbCrLf
309              Case 2:
310                  If response = "ERROR" Then GoTo configError
311                  lastModified = response
312 +                Text1.Text = Text1.Text & response & vbCrLf
313                  TCPSock.SendData "FILELIST" & vbCrLf
314 +            ' New addition to the protocol.
315              Case 3:
316                  If response = "ERROR" Then GoTo configError
317                  fileList = response
318 <                TCPSock.SendData "UDPUpdateTime" & vbCrLf
318 >                Text1.Text = Text1.Text & response & vbCrLf
319 >                TCPSock.SendData "FQDN" & vbCrLf
320              Case 4:
321                  If response = "ERROR" Then GoTo configError
322 +                Text1.Text = Text1.Text & response & vbCrLf
323 +                machineName = response
324 +                TCPSock.SendData "UDPUpdateTime" & vbCrLf
325 +            Case 5:
326 +                If response = "ERROR" Then GoTo configError
327                  UDPUpdateTime = response
328 +                Text1.Text = Text1.Text & response & vbCrLf
329                  TCPSock.SendData "TCPUpdateTime" & vbCrLf
330 <            Case 5:
330 >            Case 6:
331                  If response = "ERROR" Then GoTo configError
332                  TCPUpdateTime = response
333 +                Text1.Text = Text1.Text & response & vbCrLf
334                  TCPSock.SendData "ENDCONFIG" & vbCrLf
335 <            Case 6:
335 >            Case 7:
336                  If Not response = "OK" Then GoTo configError
337 +                Text1.Text = Text1.Text & response & vbCrLf
338                  TCPSock.SendData "FILTER" & vbCrLf
339 <            Case 7:
339 >            Case 8:
340 >                Text1.Text = Text1.Text & response & vbCrLf
341                  'we got a filter list here.
342                  readTo = 0
343                  ' get hostname
# Line 277 | Line 351 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
351                  ' get TCP Port number
352                  filterTCPPort = response
353                  TCPSock.SendData "END" & vbCrLf
354 <            Case 8:
354 >            Case 9:
355                  If Not response = "OK" Then GoTo configError
356                  connected = True
357                  responseNumber = 0
358                  TCPSock.Close
359 <                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
359 >                Text1.Text = Text1.Text & response & vbCrLf
360 >                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
361                  Status.Caption = "Configuration successful"
362                  Label3.Caption = UDPUpdateTime
363                  Label4.Caption = TCPUpdateTime
# Line 290 | Line 365 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
365          End Select
366      Else
367          ' Perform a heartbeat (1.1)
368 +        heartBeating = True
369          On Error GoTo heartbeatError
370          Select Case responseNumber
371              Case 1:
372                  If Not response = "OK" Then GoTo heartbeatError
373 +                Text1.Text = "Performing heartbeat: -" & vbCrLf
374 +                Text1.Text = Text1.Text & response & vbCrLf
375                  TCPSock.SendData "CONFIG" & vbCrLf
376              Case 2:
377                  If Not response = "OK" Then GoTo heartbeatError
378 +                Text1.Text = Text1.Text & response & vbCrLf
379                  TCPSock.SendData fileList & vbCrLf
380              Case 3:
381                  If Not response = "OK" Then GoTo heartbeatError
382 +                Text1.Text = Text1.Text & response & vbCrLf
383                  TCPSock.SendData lastModified & vbCrLf
384              Case 4:
385 <                If Not response = "OK" Then GoTo heartbeatError
385 >                If Not response = "OK" Then
386 >                    heartBeating = False
387 >                    Reconfigure_Click
388 >                End If
389 >                Text1.Text = Text1.Text & response & vbCrLf
390                  TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
391              Case 5:
392                  If Not response = "OK" Then GoTo heartbeatError
393 +                Text1.Text = Text1.Text & response & vbCrLf
394                  TCPSock.Close
395                  Status.Caption = "Heartbeat sent successfully."
396          End Select
# Line 316 | Line 401 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
401      Exit Sub
402      
403   configError:
404 <    Status.Caption = "FAILED to get configuration"
404 >    heartBeating = False
405 >    Status.Caption = "FAILED to get configuration from the server"
406      Exit Sub
407   heartbeatError:
408 +    heartBeating = False
409      Status.Caption = "Heatbeat FAILED"
410      Exit Sub
411   End Sub
# Line 334 | Line 421 | Private Sub Timer1_Timer()
421          
422          ' prepare the contents of the XML packet.
423          seqNo = seqNo + 1
424 <        machineName = TCPSock.LocalHostName
425 <        localIP = TCPSock.localIP
424 >        
425 >        netbiosName = TCPSock.LocalHostName
426 >        
427 >        LocalIP = TCPSock.LocalIP
428          packetDate = Date2Num()
429          
430          
# Line 347 | Line 436 | Private Sub Timer1_Timer()
436              End
437          End If
438            
439 <        osName = getVersion()
439 >        osName = GetVersion()
440          osVersionMajor = verinfo.dwMajorVersion
441          osVersionMinor = verinfo.dwMinorVersion
442          osBuild = verinfo.dwBuildNumber
# Line 373 | Line 462 | Private Sub Timer1_Timer()
462          Dim memory&
463          GlobalMemoryStatus memsts
464          memory& = memsts.dwTotalPhys
465 <        memTotal = memory& \ 1024
465 >        memTotal = memory& \ 1048576
466          memory& = memsts.dwAvailPhys
467 <        memFree = memory& \ 1024
467 >        memFree = memory& \ 1048576
468          memory& = memsts.dwTotalVirtual
469 <        swapTotal = memory& \ 1024
469 >        swapTotal = memory& \ 1048576
470          memory& = memsts.dwAvailVirtual
471 <        swapFree = memory& \ 1024
471 >        swapFree = memory& \ 1048576
472          
473 +        CUpTime.Capture
474 +        cpu_time = CUpTime.CPUTime
475 +        percent_idle = CUpTime.PercentIdle
476 +        
477 +        '' Doesn't work after 47 days :-/
478 +        'uptime = GetTickCount \ 1000
479 +        
480 +        'secondsRunning = secondsRunning + UDPUpdateTime
481 +        'uptime = secondsRunning
482 +        
483 +        uptime = CUpTime.MilliSecs / 1000#
484 +        
485 +        userCount = wksta.LoggedOnUsers
486 +        
487          ' build the contents of the XML packet
488 <        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
488 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
489                "<os>" & _
490 +                "<netbios_name>" & netbiosName & "</netbios_name>" & _
491                  "<name>" & osName & "</name>" & _
492 <                "<version>" & osVersionMajor & "</version>" & _
492 >                "<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
493                  "<release>" & osBuild & "</release>" & _
494 <                "<platform>" & osName & "</platform>" & _
495 <                "<minor_version>" & osVersionMinor & "</minor_version>" & _
392 <                "<processor>" & processorType & "</processor>" & _
494 >                "<platform>" & processorType & "</platform>" & _
495 >                "<uptime>" & uptime & "</uptime>" & _
496                "</os>" & _
497 +              "<users><count>" & userCount & "</count></users>" & _
498 +              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
499                "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
500                "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
501 <              ""
502 <        Text4.Text = Text4.Text + xml
501 >              "</packet>"
502 >        Text1.Text = "Last packet contained: -" & vbCrLf & xml
503  
504          ' Use the first winsock control to send a UDP packet.
505          UDPSock.RemoteHost = filterHostname

Diff Legend

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