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.16 by pjm2, Fri Feb 23 17:31:44 2001 UTC vs.
Revision 1.38 by tdb, Mon Mar 19 13:02:36 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    =   1380
8     ClientLeft      =   45
9 <   ClientTop       =   285
10 <   ClientWidth     =   4710
9 >   ClientTop       =   330
10 >   ClientWidth     =   4635
11 >   Icon            =   "nettest.frx":0000
12     LinkTopic       =   "Form1"
13     MaxButton       =   0   'False
14 <   ScaleHeight     =   5655
15 <   ScaleWidth      =   4710
14 >   MinButton       =   0   'False
15 >   ScaleHeight     =   1380
16 >   ScaleWidth      =   4635
17     ShowInTaskbar   =   0   'False
18 <   StartUpPosition =   3  'Windows Default
19 <   Begin VB.CommandButton Hide
20 <      Caption         =   "Hide Window"
21 <      Height          =   375
22 <      Left            =   3120
18 >   StartUpPosition =   2  'CenterScreen
19 >   Visible         =   0   'False
20 >   Begin VB.CommandButton Command1
21 >      Caption         =   "more"
22 >      Height          =   255
23 >      Left            =   3885
24 >      TabIndex        =   8
25 >      Top             =   1035
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             =   840
36 <      Width           =   1455
35 >      Top             =   1440
36 >      Width           =   4395
37     End
38 +   Begin VB.CommandButton Hide
39 +      Caption         =   "hide"
40 +      Height          =   255
41 +      Left            =   3225
42 +      TabIndex        =   6
43 +      Top             =   1035
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             =   3555
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
81 +   Begin VB.Image Image1
82 +      Height          =   900
83 +      Left            =   2400
84 +      Picture         =   "nettest.frx":08CA
85 +      Top             =   90
86 +      Width           =   2100
87 +   End
88     Begin VB.Label Label2
89        Alignment       =   1  'Right Justify
90        Caption         =   "Next heartbeat:"
91        Height          =   255
92 <      Left            =   2400
93 <      TabIndex        =   6
94 <      Top             =   480
92 >      Left            =   120
93 >      TabIndex        =   5
94 >      Top             =   645
95        Width           =   1455
96     End
97     Begin VB.Label Label1
98        Alignment       =   1  'Right Justify
99        Caption         =   "Next UDP packet:"
100        Height          =   255
101 <      Left            =   2400
102 <      TabIndex        =   5
103 <      Top             =   120
101 >      Left            =   120
102 >      TabIndex        =   4
103 >      Top             =   165
104        Width           =   1455
105     End
106     Begin VB.Label Label4
107        BorderStyle     =   1  'Fixed Single
108        Caption         =   "0"
109        Height          =   255
110 <      Left            =   3960
111 <      TabIndex        =   4
112 <      Top             =   480
110 >      Left            =   1680
111 >      TabIndex        =   3
112 >      Top             =   645
113        Width           =   615
114     End
115     Begin VB.Label Label3
116        BorderStyle     =   1  'Fixed Single
117        Caption         =   "0"
118        Height          =   255
119 <      Left            =   3960
120 <      TabIndex        =   3
121 <      Top             =   120
119 >      Left            =   1680
120 >      TabIndex        =   2
121 >      Top             =   165
122        Width           =   615
123     End
124     Begin VB.Label Status
125        Alignment       =   2  'Center
126        Caption         =   "Status:"
127        Height          =   255
128 <      Left            =   120
129 <      TabIndex        =   2
130 <      Top             =   1320
131 <      Width           =   4455
128 >      Left            =   0
129 >      TabIndex        =   1
130 >      Top             =   1035
131 >      Width           =   3180
132     End
133   End
134   Attribute VB_Name = "Form1"
# Line 123 | Line 141 | Private Declare Function GetPrivateProfileString Lib "
141   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
142  
143   Dim filterManagerHostname As String
144 < Dim filterManagerTCPPort As Integer
144 > Dim filterManagerTCPPort As Long
145  
146   Dim seqNo As Long
147   Dim machineName As String
148  
149 + Dim secondsRunning As Long
150 +
151   Dim filterHostname As String
152   Dim filterTCPPort As Integer
153   Dim filterUDPPort As Integer
154   Dim fileList As String
155   Dim lastModified As String
156  
157 + Dim fourtySevenDays As Integer
158 +
159   Dim UDPUpdateTime As Integer
160   Dim TCPUpdateTime As Integer
161  
162   Dim protocolVersion As String
163   Dim connected As Boolean
164 + Dim heartBeating As Boolean
165  
166 < 'Dim CUpTime As New CUpTime
166 > Dim CUpTime As New CUpTime
167 > Dim wksta As New CNetWksta
168  
169 + Dim windowBig As Boolean
170 +
171   Dim responseNumber As Integer
172  
173 + Private Sub Command1_Click()
174 +
175 +    ' Toggle visibility of the debug output.
176 +
177 +    If windowBig Then
178 +        Form1.Height = 1755
179 +        windowBig = False
180 +    Else
181 +        Form1.Height = 4380
182 +        windowBig = True
183 +    End If
184 +
185 + End Sub
186 +
187   Private Sub Form_Load()
188      
189 +    If App.PrevInstance Then
190 +        x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
191 +        End
192 +    End If
193 +    
194 +    ' Assume the host is run within the first 47 days of the machine starting.
195 +    fourtySevenDays = 0
196 +    
197      protocolVersion = "1.1"
198      
199      Status.Caption = "Loading"
200 <    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
200 >    Form1.Caption = "i-scream Winhost " & protocolVersion
201      
202 +    CUpTime.Init
203 +    
204 +    If CUpTime.isWin9x Then
205 +        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
206 +        End
207 +    End If
208 +    
209 +    windowBig = False
210 +    
211      ''''TEMP
212 <    filterManagerHostname = "killigrew.ukc.ac.uk"
213 <    filterManagerTCPPort = 4567
212 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
213 >    'filterManagerTCPPort = 4567
214      ''''' END TEMP
215      
216 <    GoTo skip
216 >    'GoTo skip
217      On Error GoTo iniError
218      Dim buf As String * 256
219      Dim length As Long
220 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
220 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
221      filterManagerHostname = Left$(buf, length)
222 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
223 <    filterManagerTCPPort = Left$(buf, length)
222 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
223 >    filterManagerTCPPort = length
224 >    If filterManagerHostname = "" Then
225 >        GoTo iniError
226 >    End If
227 >    On Error GoTo 0
228   skip:
229  
230 <    Status.Caption = "Connecting to Filter Manager"
230 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
231      Reconfigure_Click
232      
233 <    Form1.Show
233 >    SystemTray.Icon = Val(Form1.Icon)
234      SystemTray.Action = 0
235      
236      
237      Exit Sub
238      
239   iniError:
240 <    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")
240 >    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")
241      End
242      
243   End Sub
# Line 196 | Line 257 | Private Sub Hide_Click()
257      SystemTray.Icon = Val(Form1.Icon)
258   End Sub
259  
260 +
261   Private Sub Reconfigure_Click()
262      ' establish a TCP connection to a filtermanager
263 <    connected = False
264 <    TCPSock.Close
265 <    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
263 >    If Not heartBeating Then
264 >        connected = False
265 >        TCPSock.Close
266 >        TCPSock.Connect filterManagerHostname, filterManagerTCPPort
267 >    Else
268 >        Status.Caption = "Cannot reconfigure while heartbeating"
269 >    End If
270   End Sub
271  
272  
# Line 209 | Line 275 | Private Sub SystemTray_MouseDblClk(ByVal Button As Int
275  
276      Form1.Visible = True
277      Form1.SetFocus
212 –    
278  
279   End Sub
280  
# Line 238 | Line 303 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
303      ' Remove linefeeds and returns from the line.
304      response = Replace(response, Chr(13), "")
305      response = Replace(response, Chr(10), "")
241 –    Text4.Text = Text4.Text & vbCrLf & response
306      
307      If connected = False Then
308          ' Perform TCP configuration (1.1)
# Line 247 | Line 311 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
311              Case 1:
312                  If Not response = "OK" Then GoTo configError
313                  TCPSock.SendData "LASTMODIFIED" & vbCrLf
314 +                Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
315 +                Text1.Text = Text1.Text & response & vbCrLf
316              Case 2:
317                  If response = "ERROR" Then GoTo configError
318                  lastModified = response
319 +                Text1.Text = Text1.Text & response & vbCrLf
320                  TCPSock.SendData "FILELIST" & vbCrLf
321 +            ' New addition to the protocol.
322              Case 3:
323                  If response = "ERROR" Then GoTo configError
324                  fileList = response
325 <                TCPSock.SendData "UDPUpdateTime" & vbCrLf
325 >                Text1.Text = Text1.Text & response & vbCrLf
326 >                TCPSock.SendData "FQDN" & vbCrLf
327              Case 4:
328                  If response = "ERROR" Then GoTo configError
329 +                Text1.Text = Text1.Text & response & vbCrLf
330 +                machineName = response
331 +                TCPSock.SendData "UDPUpdateTime" & vbCrLf
332 +            Case 5:
333 +                If response = "ERROR" Then GoTo configError
334                  UDPUpdateTime = response
335 +                Text1.Text = Text1.Text & response & vbCrLf
336                  TCPSock.SendData "TCPUpdateTime" & vbCrLf
337 <            Case 5:
337 >            Case 6:
338                  If response = "ERROR" Then GoTo configError
339                  TCPUpdateTime = response
340 +                Text1.Text = Text1.Text & response & vbCrLf
341                  TCPSock.SendData "ENDCONFIG" & vbCrLf
342 <            Case 6:
342 >            Case 7:
343                  If Not response = "OK" Then GoTo configError
344 +                Text1.Text = Text1.Text & response & vbCrLf
345                  TCPSock.SendData "FILTER" & vbCrLf
346 <            Case 7:
346 >            Case 8:
347 >                Text1.Text = Text1.Text & response & vbCrLf
348                  'we got a filter list here.
349                  readTo = 0
350                  ' get hostname
# Line 280 | Line 358 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
358                  ' get TCP Port number
359                  filterTCPPort = response
360                  TCPSock.SendData "END" & vbCrLf
361 <            Case 8:
361 >            Case 9:
362                  If Not response = "OK" Then GoTo configError
363                  connected = True
364                  responseNumber = 0
365                  TCPSock.Close
366 <                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
366 >                Text1.Text = Text1.Text & response & vbCrLf
367 >                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
368                  Status.Caption = "Configuration successful"
369                  Label3.Caption = UDPUpdateTime
370                  Label4.Caption = TCPUpdateTime
# Line 293 | Line 372 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
372          End Select
373      Else
374          ' Perform a heartbeat (1.1)
375 +        heartBeating = True
376          On Error GoTo heartbeatError
377          Select Case responseNumber
378              Case 1:
379                  If Not response = "OK" Then GoTo heartbeatError
380 +                Text1.Text = "Performing heartbeat: -" & vbCrLf
381 +                Text1.Text = Text1.Text & response & vbCrLf
382                  TCPSock.SendData "CONFIG" & vbCrLf
383              Case 2:
384                  If Not response = "OK" Then GoTo heartbeatError
385 +                Text1.Text = Text1.Text & response & vbCrLf
386                  TCPSock.SendData fileList & vbCrLf
387              Case 3:
388                  If Not response = "OK" Then GoTo heartbeatError
389 +                Text1.Text = Text1.Text & response & vbCrLf
390                  TCPSock.SendData lastModified & vbCrLf
391              Case 4:
392 <                If Not response = "OK" Then GoTo heartbeatError
392 >                If Not response = "OK" Then
393 >                    heartBeating = False
394 >                    Reconfigure_Click
395 >                End If
396 >                Text1.Text = Text1.Text & response & vbCrLf
397                  TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
398              Case 5:
399                  If Not response = "OK" Then GoTo heartbeatError
400 +                Text1.Text = Text1.Text & response & vbCrLf
401                  TCPSock.Close
402                  Status.Caption = "Heartbeat sent successfully."
403          End Select
# Line 319 | Line 408 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
408      Exit Sub
409      
410   configError:
411 <    Status.Caption = "FAILED to get configuration"
411 >    heartBeating = False
412 >    Status.Caption = "FAILED to get configuration from the server"
413      Exit Sub
414   heartbeatError:
415 +    heartBeating = False
416      Status.Caption = "Heatbeat FAILED"
417      Exit Sub
418   End Sub
# Line 337 | Line 428 | Private Sub Timer1_Timer()
428          
429          ' prepare the contents of the XML packet.
430          seqNo = seqNo + 1
431 <        machineName = TCPSock.LocalHostName
431 >        
432 >        netbiosName = TCPSock.LocalHostName
433 >        
434          LocalIP = TCPSock.LocalIP
435          packetDate = Date2Num()
436          
# Line 350 | Line 443 | Private Sub Timer1_Timer()
443              End
444          End If
445            
446 <        osName = getVersion()
446 >        osName = GetVersion()
447          osVersionMajor = verinfo.dwMajorVersion
448          osVersionMinor = verinfo.dwMinorVersion
449          osBuild = verinfo.dwBuildNumber
# Line 376 | Line 469 | Private Sub Timer1_Timer()
469          Dim memory&
470          GlobalMemoryStatus memsts
471          memory& = memsts.dwTotalPhys
472 <        memTotal = memory& \ 1024
472 >        memTotal = memory& \ 1048576
473          memory& = memsts.dwAvailPhys
474 <        memFree = memory& \ 1024
474 >        memFree = memory& \ 1048576
475          memory& = memsts.dwTotalVirtual
476 <        swapTotal = memory& \ 1024
476 >        swapTotal = memory& \ 1048576
477          memory& = memsts.dwAvailVirtual
478 <        swapFree = memory& \ 1024
478 >        swapFree = memory& \ 1048576
479          
480 +        CUpTime.Capture
481 +        cpu_time = CUpTime.CPUTime
482 +        percent_idle = CUpTime.PercentIdle
483 +        
484 +        '' Doesn't work after 47 days :-/
485 +        'uptime = GetTickCount \ 1000
486 +        
487 +        'secondsRunning = secondsRunning + UDPUpdateTime
488 +        'uptime = secondsRunning
489 +        
490 +        uptime = CUpTime.MilliSecs / 1000#
491 +        
492 +        userCount = wksta.LoggedOnUsers
493 +        
494          ' build the contents of the XML packet
495          xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
496                "<os>" & _
497 +                "<netbios_name>" & netbiosName & "</netbios_name>" & _
498                  "<name>" & osName & "</name>" & _
499 <                "<version>" & osVersionMajor & "</version>" & _
499 >                "<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
500                  "<release>" & osBuild & "</release>" & _
501 <                "<platform>" & osName & "</platform>" & _
502 <                "<minor_version>" & osVersionMinor & "</minor_version>" & _
395 <                "<processor>" & processorType & "</processor>" & _
501 >                "<platform>" & processorType & "</platform>" & _
502 >                "<uptime>" & uptime & "</uptime>" & _
503                "</os>" & _
504 +              "<users><count>" & userCount & "</count></users>" & _
505 +              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
506                "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
507                "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
508 <              ""
509 <        Text4.Text = Text4.Text + xml
508 >              "</packet>"
509 >        Text1.Text = "Last packet contained: -" & vbCrLf & xml
510  
511          ' Use the first winsock control to send a UDP packet.
512          UDPSock.RemoteHost = filterHostname

Diff Legend

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