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.18 by pjm2, Fri Feb 23 17:51:07 2001 UTC vs.
Revision 1.34 by pjm2, Wed Mar 14 11:03:45 2001 UTC

# Line 4 | Line 4 | Object = "{33155A3D-0CE0-11D1-A6B4-444553540000}#1.0#0
4   Begin VB.Form Form1
5     BorderStyle     =   3  'Fixed Dialog
6     Caption         =   "i-scream Winhost"
7 <   ClientHeight    =   5655
7 >   ClientHeight    =   1185
8     ClientLeft      =   45
9     ClientTop       =   330
10     ClientWidth     =   4710
11 +   Icon            =   "nettest.frx":0000
12     LinkTopic       =   "Form1"
13     MaxButton       =   0   'False
14     MinButton       =   0   'False
15 <   ScaleHeight     =   5655
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
38 –   Begin VB.TextBox Text4
39 –      Height          =   1575
40 –      Left            =   240
41 –      MultiLine       =   -1  'True
42 –      ScrollBars      =   2  'Vertical
43 –      TabIndex        =   1
44 –      Text            =   "nettest.frx":0000
45 –      Top             =   3000
46 –      Width           =   3975
47 –   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
79        Protocol        =   1
80     End
71 –   Begin VB.Label Label5
72 –      Caption         =   "b e t a"
73 –      BeginProperty Font
74 –         Name            =   "MS Sans Serif"
75 –         Size            =   24
76 –         Charset         =   0
77 –         Weight          =   700
78 –         Underline       =   0   'False
79 –         Italic          =   0   'False
80 –         Strikethrough   =   0   'False
81 –      EndProperty
82 –      Height          =   615
83 –      Left            =   240
84 –      TabIndex        =   8
85 –      Top             =   120
86 –      Width           =   1815
87 –   End
81     Begin VB.Label Label2
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 98 | 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 107 | 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 116 | 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 126 | Line 119 | Begin VB.Form Form1
119        Caption         =   "Status:"
120        Height          =   255
121        Left            =   0
122 <      TabIndex        =   2
123 <      Top             =   1320
124 <      Width           =   4695
122 >      TabIndex        =   1
123 >      Top             =   840
124 >      Width           =   3855
125     End
126   End
127   Attribute VB_Name = "Form1"
# Line 146 | Line 139 | Dim filterManagerTCPPort As Long
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
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
# Line 182 | Line 214 | Private Sub Form_Load()
214      filterManagerHostname = 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 " & filterManagerHostname & ":" & filterManagerTCPPort
224      Reconfigure_Click
225      
226 <    Form1.Show
226 >    SystemTray.Icon = Val(Form1.Icon)
227      SystemTray.Action = 0
228      
229      
# Line 214 | 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 227 | Line 268 | Private Sub SystemTray_MouseDblClk(ByVal Button As Int
268  
269      Form1.Visible = True
270      Form1.SetFocus
230 –    
271  
272   End Sub
273  
# Line 256 | 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), "")
259 –    Text4.Text = Text4.Text & vbCrLf & response
299      
300      If connected = False Then
301          ' Perform TCP configuration (1.1)
# Line 265 | 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 298 | 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 311 | 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 337 | 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 355 | Line 421 | Private Sub Timer1_Timer()
421          
422          ' prepare the contents of the XML packet.
423          seqNo = seqNo + 1
424 <        machineName = TCPSock.LocalHostName
424 >        
425 >        netbiosName = TCPSock.LocalHostName
426 >        
427          LocalIP = TCPSock.LocalIP
428          packetDate = Date2Num()
429          
# Line 368 | 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 394 | 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 & """>" & _
489                "<os>" & _
490 +                "<netbios_name>" & netbiosName & "</netbios_name>" & _
491                  "<name>" & osName & "</name>" & _
492                  "<version>" & osVersionMajor & "</version>" & _
493                  "<release>" & osBuild & "</release>" & _
494                  "<platform>" & osName & "</platform>" & _
495                  "<minor_version>" & osVersionMinor & "</minor_version>" & _
496                  "<processor>" & processorType & "</processor>" & _
497 +                "<uptime>" & uptime & "</uptime>" & _
498                "</os>" & _
499 +              "<users><count>" & userCount & "</count></users>" & _
500 +              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
501                "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
502                "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
503                "</packet>"
504 <        Text4.Text = Text4.Text + xml
504 >        Text1.Text = "Last packet contained: -" & vbCrLf & xml
505  
506          ' Use the first winsock control to send a UDP packet.
507          UDPSock.RemoteHost = filterHostname

Diff Legend

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