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.33 by pjm2, Wed Mar 14 10:47:26 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 +
158 + Dim CUpTime As New CUpTime
159 + Dim wksta As New CNetWksta
160 +
161 + Dim windowBig As Boolean
162 +
163   Dim responseNumber As Integer
164  
165 + Private Sub Command1_Click()
166 +
167 +    ' Toggle visibility of the debug output.
168 +
169 +    If windowBig Then
170 +        Form1.Height = 1500
171 +        windowBig = False
172 +    Else
173 +        Form1.Height = 4350
174 +        windowBig = True
175 +    End If
176 +
177 + End Sub
178 +
179   Private Sub Form_Load()
180      
181 +    If App.PrevInstance Then
182 +        x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
183 +        End
184 +    End If
185 +    
186 +    ' Assume the host is run within the first 47 days of the machine starting.
187 +    fourtySevenDays = 0
188 +    
189      protocolVersion = "1.1"
190      
191      Status.Caption = "Loading"
192 <    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
192 >    Form1.Caption = "i-scream Winhost " & protocolVersion
193      
194 +    CUpTime.Init
195 +    
196 +    If CUpTime.isWin9x Then
197 +        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
198 +        End
199 +    End If
200 +    
201 +    windowBig = False
202 +    
203      ''''TEMP
204 <    filterManagerHostname = "killigrew.ukc.ac.uk"
205 <    filterManagerTCPPort = 4567
204 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
205 >    'filterManagerTCPPort = 4567
206      ''''' END TEMP
207      
208 <    GoTo skip
208 >    'GoTo skip
209      On Error GoTo iniError
210      Dim buf As String * 256
211      Dim length As Long
212 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
212 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
213      filterManagerHostname = Left$(buf, length)
214 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
215 <    filterManagerTCPPort = Left$(buf, length)
214 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
215 >    filterManagerTCPPort = length
216 >    If filterManagerHostname = "" Then
217 >        GoTo iniError
218 >    End If
219 >    On Error GoTo 0
220   skip:
221  
222 <    Status.Caption = "Connecting to Filter Manager"
222 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
223      Reconfigure_Click
224      
225 <    Form1.Show
225 >    SystemTray.Icon = Val(Form1.Icon)
226      SystemTray.Action = 0
227      
228      
229      Exit Sub
230      
231   iniError:
232 <    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")
232 >    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")
233      End
234      
235   End Sub
# Line 193 | Line 249 | Private Sub Hide_Click()
249      SystemTray.Icon = Val(Form1.Icon)
250   End Sub
251  
252 + Private Sub Image1_Click()
253 +
254 + End Sub
255 +
256   Private Sub Reconfigure_Click()
257      ' establish a TCP connection to a filtermanager
258      connected = False
# Line 206 | Line 266 | Private Sub SystemTray_MouseDblClk(ByVal Button As Int
266  
267      Form1.Visible = True
268      Form1.SetFocus
209 –    
269  
270   End Sub
271  
# Line 235 | Line 294 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
294      ' Remove linefeeds and returns from the line.
295      response = Replace(response, Chr(13), "")
296      response = Replace(response, Chr(10), "")
238 –    Text4.Text = Text4.Text & vbCrLf & response
297      
298      If connected = False Then
299          ' Perform TCP configuration (1.1)
# Line 244 | Line 302 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
302              Case 1:
303                  If Not response = "OK" Then GoTo configError
304                  TCPSock.SendData "LASTMODIFIED" & vbCrLf
305 +                Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
306 +                Text1.Text = Text1.Text & response & vbCrLf
307              Case 2:
308                  If response = "ERROR" Then GoTo configError
309                  lastModified = response
310 +                Text1.Text = Text1.Text & response & vbCrLf
311                  TCPSock.SendData "FILELIST" & vbCrLf
312 +            ' New addition to the protocol.
313              Case 3:
314                  If response = "ERROR" Then GoTo configError
315                  fileList = response
316 <                TCPSock.SendData "UDPUpdateTime" & vbCrLf
316 >                Text1.Text = Text1.Text & response & vbCrLf
317 >                TCPSock.SendData "FQDN" & vbCrLf
318              Case 4:
319                  If response = "ERROR" Then GoTo configError
320 +                Text1.Text = Text1.Text & response & vbCrLf
321 +                machineName = response
322 +                TCPSock.SendData "UDPUpdateTime" & vbCrLf
323 +            Case 5:
324 +                If response = "ERROR" Then GoTo configError
325                  UDPUpdateTime = response
326 +                Text1.Text = Text1.Text & response & vbCrLf
327                  TCPSock.SendData "TCPUpdateTime" & vbCrLf
328 <            Case 5:
328 >            Case 6:
329                  If response = "ERROR" Then GoTo configError
330                  TCPUpdateTime = response
331 +                Text1.Text = Text1.Text & response & vbCrLf
332                  TCPSock.SendData "ENDCONFIG" & vbCrLf
333 <            Case 6:
333 >            Case 7:
334                  If Not response = "OK" Then GoTo configError
335 +                Text1.Text = Text1.Text & response & vbCrLf
336                  TCPSock.SendData "FILTER" & vbCrLf
337 <            Case 7:
337 >            Case 8:
338 >                Text1.Text = Text1.Text & response & vbCrLf
339                  'we got a filter list here.
340                  readTo = 0
341                  ' get hostname
# Line 277 | Line 349 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
349                  ' get TCP Port number
350                  filterTCPPort = response
351                  TCPSock.SendData "END" & vbCrLf
352 <            Case 8:
352 >            Case 9:
353                  If Not response = "OK" Then GoTo configError
354                  connected = True
355                  responseNumber = 0
356                  TCPSock.Close
357 <                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
357 >                Text1.Text = Text1.Text & response & vbCrLf
358 >                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
359                  Status.Caption = "Configuration successful"
360                  Label3.Caption = UDPUpdateTime
361                  Label4.Caption = TCPUpdateTime
# Line 294 | Line 367 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
367          Select Case responseNumber
368              Case 1:
369                  If Not response = "OK" Then GoTo heartbeatError
370 +                Text1.Text = "Performing heartbeat: -" & vbCrLf
371 +                Text1.Text = Text1.Text & response & vbCrLf
372                  TCPSock.SendData "CONFIG" & vbCrLf
373              Case 2:
374                  If Not response = "OK" Then GoTo heartbeatError
375 +                Text1.Text = Text1.Text & response & vbCrLf
376                  TCPSock.SendData fileList & vbCrLf
377              Case 3:
378                  If Not response = "OK" Then GoTo heartbeatError
379 +                Text1.Text = Text1.Text & response & vbCrLf
380                  TCPSock.SendData lastModified & vbCrLf
381              Case 4:
382                  If Not response = "OK" Then GoTo heartbeatError
383 +                Text1.Text = Text1.Text & response & vbCrLf
384                  TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
385              Case 5:
386                  If Not response = "OK" Then GoTo heartbeatError
387 +                Text1.Text = Text1.Text & response & vbCrLf
388                  TCPSock.Close
389                  Status.Caption = "Heartbeat sent successfully."
390          End Select
# Line 316 | Line 395 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
395      Exit Sub
396      
397   configError:
398 <    Status.Caption = "FAILED to get configuration"
398 >    Status.Caption = "FAILED to get configuration from the server"
399      Exit Sub
400   heartbeatError:
401      Status.Caption = "Heatbeat FAILED"
# Line 334 | Line 413 | Private Sub Timer1_Timer()
413          
414          ' prepare the contents of the XML packet.
415          seqNo = seqNo + 1
416 <        machineName = TCPSock.LocalHostName
417 <        localIP = TCPSock.localIP
416 >        
417 >        netbiosName = TCPSock.LocalHostName
418 >        
419 >        LocalIP = TCPSock.LocalIP
420          packetDate = Date2Num()
421          
422          
# Line 347 | Line 428 | Private Sub Timer1_Timer()
428              End
429          End If
430            
431 <        osName = getVersion()
431 >        osName = GetVersion()
432          osVersionMajor = verinfo.dwMajorVersion
433          osVersionMinor = verinfo.dwMinorVersion
434          osBuild = verinfo.dwBuildNumber
# Line 373 | Line 454 | Private Sub Timer1_Timer()
454          Dim memory&
455          GlobalMemoryStatus memsts
456          memory& = memsts.dwTotalPhys
457 <        memTotal = memory& \ 1024
457 >        memTotal = memory& \ 1048576
458          memory& = memsts.dwAvailPhys
459 <        memFree = memory& \ 1024
459 >        memFree = memory& \ 1048576
460          memory& = memsts.dwTotalVirtual
461 <        swapTotal = memory& \ 1024
461 >        swapTotal = memory& \ 1048576
462          memory& = memsts.dwAvailVirtual
463 <        swapFree = memory& \ 1024
463 >        swapFree = memory& \ 1048576
464          
465 +        CUpTime.Capture
466 +        cpu_time = CUpTime.CPUTime
467 +        percent_idle = CUpTime.PercentIdle
468 +        
469 +        '' Doesn't work after 47 days :-/
470 +        'uptime = GetTickCount \ 1000
471 +        
472 +        'secondsRunning = secondsRunning + UDPUpdateTime
473 +        'uptime = secondsRunning
474 +        
475 +        uptime = CUpTime.MilliSecs / 1000#
476 +        
477 +        userCount = wksta.LoggedOnUsers
478 +        
479          ' build the contents of the XML packet
480 <        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
480 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
481                "<os>" & _
482 +                "<netbios_name>" & netbiosName & "</netbios_name>" & _
483                  "<name>" & osName & "</name>" & _
484                  "<version>" & osVersionMajor & "</version>" & _
485                  "<release>" & osBuild & "</release>" & _
486                  "<platform>" & osName & "</platform>" & _
487                  "<minor_version>" & osVersionMinor & "</minor_version>" & _
488                  "<processor>" & processorType & "</processor>" & _
489 +                "<uptime>" & uptime & "</uptime>" & _
490                "</os>" & _
491 +              "<users><count>" & userCount & "</count></users>" & _
492 +              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
493                "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
494                "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
495 <              ""
496 <        Text4.Text = Text4.Text + xml
495 >              "</packet>"
496 >        Text1.Text = "Last packet contained: -" & vbCrLf & xml
497  
498          ' Use the first winsock control to send a UDP packet.
499          UDPSock.RemoteHost = filterHostname

Diff Legend

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