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.14 by pjm2, Fri Feb 23 13:27:09 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 118 | Line 136 | Attribute VB_GlobalNameSpace = False
136   Attribute VB_Creatable = False
137   Attribute VB_PredeclaredId = True
138   Attribute VB_Exposed = False
139 + ' For the system tray bits
140   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
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
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
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 +    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 177 | Line 246 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
246      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")
247      If x = 7 Then
248          Cancel = True
249 +    Else
250 +        SystemTray.Action = 2
251      End If
181 –    SystemTray.Action = 2
252  
253   End Sub
254  
255   Private Sub Hide_Click()
256      Form1.Visible = False
257      SystemTray.Icon = Val(Form1.Icon)
188 –    SystemTray.Action = 0
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 200 | Line 274 | End Sub
274   Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
275  
276      Form1.Visible = True
203 –    SystemTray.Action = 2
277      Form1.SetFocus
205 –    
278  
279   End Sub
280  
# Line 231 | 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), "")
234 –    Text4.Text = Text4.Text & vbCrLf & response
306      
307      If connected = False Then
308          ' Perform TCP configuration (1.1)
# Line 240 | 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 273 | 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 286 | 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 312 | 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 327 | Line 425 | Private Sub Timer1_Timer()
425      Status.Caption = ""
426      
427      If Label3.Caption < 1 Then
428 <        ' build the contents of the XML packet.
429 <        localIP = TCPSock.localIP
332 <        machineName = TCPSock.LocalHostName
428 >        
429 >        ' prepare the contents of the XML packet.
430          seqNo = seqNo + 1
431 +        
432 +        netbiosName = TCPSock.LocalHostName
433 +        
434 +        LocalIP = TCPSock.LocalIP
435          packetDate = Date2Num()
436 <        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
437 <              "" & _
438 <              "" & _
439 <              "" & _
440 <              "" & _
441 <              "" & _
442 <              "" & _
443 <              "" & _
444 <              "" & _
445 <              "" & _
446 <              "" & _
447 <              "" & _
448 <              "" & _
449 <              "" & _
450 <              "" & _
451 <              ""
452 <        Text4.Text = Text4.Text + xml
436 >        
437 >        
438 >        Dim verinfo As OSVERSIONINFO
439 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
440 >        ret% = GetVersionEx(verinfo)
441 >        If ret% = 0 Then
442 >            MsgBox "Error getting Windows version Information"
443 >            End
444 >        End If
445 >          
446 >        osName = GetVersion()
447 >        osVersionMajor = verinfo.dwMajorVersion
448 >        osVersionMinor = verinfo.dwMinorVersion
449 >        osBuild = verinfo.dwBuildNumber
450 >        
451 >        Dim sysinfo As SYSTEM_INFO
452 >        GetSystemInfo sysinfo
453 >        Select Case sysinfo.dwProcessorType
454 >            Case PROCESSOR_INTEL_386
455 >                processorType = "Intel 386"
456 >            Case PROCESSOR_INTEL_486
457 >                processorType = "Intel 486"
458 >            Case PROCESSOR_INTEL_PENTIUM
459 >                processorType = "Intel Pentium variant"
460 >            Case PROCESSOR_MIPS_R4000
461 >                processorType = "MIPS R4000"
462 >            Case PROCESSOR_ALPHA_21064
463 >                processorType = "DEC Alpha 21064"
464 >            Case Else
465 >                processorType = "(unknown)"
466 >        End Select
467 >        
468 >        Dim memsts As MEMORYSTATUS
469 >        Dim memory&
470 >        GlobalMemoryStatus memsts
471 >        memory& = memsts.dwTotalPhys
472 >        memTotal = memory& \ 1048576
473 >        memory& = memsts.dwAvailPhys
474 >        memFree = memory& \ 1048576
475 >        memory& = memsts.dwTotalVirtual
476 >        swapTotal = memory& \ 1048576
477 >        memory& = memsts.dwAvailVirtual
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 & "." & osVersionMinor & "</version>" & _
500 >                "<release>" & osBuild & "</release>" & _
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 >              "</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