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.34 by pjm2, Wed Mar 14 11:03:45 2001 UTC vs.
Revision 1.39 by pjm2, Thu Mar 22 09:27:04 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    =   1185
7 >   ClientHeight    =   1380
8     ClientLeft      =   45
9     ClientTop       =   330
10 <   ClientWidth     =   4710
10 >   ClientWidth     =   4635
11     Icon            =   "nettest.frx":0000
12     LinkTopic       =   "Form1"
13     MaxButton       =   0   'False
14     MinButton       =   0   'False
15 <   ScaleHeight     =   1185
16 <   ScaleWidth      =   4710
15 >   ScaleHeight     =   1380
16 >   ScaleWidth      =   4635
17     ShowInTaskbar   =   0   'False
18     StartUpPosition =   2  'CenterScreen
19     Visible         =   0   'False
20     Begin VB.CommandButton Command1
21        Caption         =   "more"
22        Height          =   255
23 <      Left            =   3960
23 >      Left            =   3885
24        TabIndex        =   8
25 <      Top             =   840
25 >      Top             =   1035
26        Width           =   615
27     End
28     Begin VB.TextBox Text1
# Line 32 | Line 32 | Begin VB.Form Form1
32        MultiLine       =   -1  'True
33        ScrollBars      =   2  'Vertical
34        TabIndex        =   7
35 <      Top             =   1200
36 <      Width           =   4455
35 >      Top             =   1440
36 >      Width           =   4395
37     End
38     Begin VB.CommandButton Hide
39        Caption         =   "hide"
40        Height          =   255
41 <      Left            =   3960
41 >      Left            =   3225
42        TabIndex        =   6
43 <      Top             =   480
43 >      Top             =   1035
44        Width           =   615
45     End
46     Begin SysTray.SystemTray SystemTray
# Line 60 | Line 60 | Begin VB.Form Form1
60        Height          =   375
61        Left            =   840
62        TabIndex        =   0
63 <      Top             =   3480
63 >      Top             =   3555
64        Width           =   2895
65     End
66     Begin MSWinsockLib.Winsock TCPSock
# Line 78 | Line 78 | Begin VB.Form Form1
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            =   120
93        TabIndex        =   5
94 <      Top             =   480
94 >      Top             =   645
95        Width           =   1455
96     End
97     Begin VB.Label Label1
# Line 93 | Line 100 | Begin VB.Form Form1
100        Height          =   255
101        Left            =   120
102        TabIndex        =   4
103 <      Top             =   120
103 >      Top             =   165
104        Width           =   1455
105     End
106     Begin VB.Label Label4
# Line 102 | Line 109 | Begin VB.Form Form1
109        Height          =   255
110        Left            =   1680
111        TabIndex        =   3
112 <      Top             =   480
112 >      Top             =   645
113        Width           =   615
114     End
115     Begin VB.Label Label3
# Line 111 | Line 118 | Begin VB.Form Form1
118        Height          =   255
119        Left            =   1680
120        TabIndex        =   2
121 <      Top             =   120
121 >      Top             =   165
122        Width           =   615
123     End
124     Begin VB.Label Status
# Line 120 | Line 127 | Begin VB.Form Form1
127        Height          =   255
128        Left            =   0
129        TabIndex        =   1
130 <      Top             =   840
131 <      Width           =   3855
130 >      Top             =   1035
131 >      Width           =   3180
132     End
133   End
134   Attribute VB_Name = "Form1"
# Line 129 | 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
139 > ' For the system tray methods
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 + ' Address of the filter manager
144   Dim filterManagerHostname As String
145   Dim filterManagerTCPPort As Long
146  
147 + ' Sequence number and machine name are sent in each UDP packet.
148   Dim seqNo As Long
149   Dim machineName As String
150  
151 + ' DEPRICATED.  The number of seconds that the program has been running.
152   Dim secondsRunning As Long
153  
154 + ' Address of the filter to use.
155   Dim filterHostname As String
156   Dim filterTCPPort As Integer
157   Dim filterUDPPort As Integer
158 +
159 + ' Server configuration details.
160   Dim fileList As String
161   Dim lastModified As String
162  
163 < Dim fourtySevenDays As Integer
151 <
163 > ' Time intervals between UDP packets and heartbeats.
164   Dim UDPUpdateTime As Integer
165   Dim TCPUpdateTime As Integer
166  
167 + ' The protocol version used by the winhost.
168   Dim protocolVersion As String
169 +
170 + ' Action flags.
171   Dim connected As Boolean
172   Dim heartBeating As Boolean
173 + Dim windowBig As Boolean
174  
175 + ' Define classes to be used to obtain uptime and number of users.
176   Dim CUpTime As New CUpTime
177   Dim wksta As New CNetWksta
178  
179 < Dim windowBig As Boolean
163 <
179 > ' Keep track of the line number in TCP communications.
180   Dim responseNumber As Integer
181  
166 Private Sub Command1_Click()
182  
183 <    ' Toggle visibility of the debug output.
184 <
183 > ' Toggle visibility of the debug output.
184 > Private Sub Command1_Click()
185      If windowBig Then
186 <        Form1.Height = 1500
186 >        Form1.Height = 1755
187          windowBig = False
188      Else
189 <        Form1.Height = 4350
189 >        Form1.Height = 4380
190          windowBig = True
191      End If
177
192   End Sub
193  
194 +
195 + ' Main method (or its Visual Basic equivalent!).
196   Private Sub Form_Load()
197      
198 +    ' Do not let any user run the program twice on one machine.
199      If App.PrevInstance Then
200          x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
201          End
202      End If
203      
187    ' Assume the host is run within the first 47 days of the machine starting.
188    fourtySevenDays = 0
189    
204      protocolVersion = "1.1"
205      
206      Status.Caption = "Loading"
# Line 194 | Line 208 | Private Sub Form_Load()
208      
209      CUpTime.Init
210      
211 +    ' Some class functions only work on NT-based systems, and Win9x boxes
212 +    ' are rarely used as servers, anyway.
213      If CUpTime.isWin9x Then
214          x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
215          End
216      End If
217      
218 +    ' Start the program with the small window size.
219      windowBig = False
220      
221 <    ''''TEMP
205 <    'filterManagerHostname = "killigrew.ukc.ac.uk"
206 <    'filterManagerTCPPort = 4567
207 <    ''''' END TEMP
208 <    
209 <    'GoTo skip
221 >    ' Catch errors while reading the configuration from the ini file.
222      On Error GoTo iniError
223 +    
224      Dim buf As String * 256
225      Dim length As Long
226 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
226 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "", buf, Len(buf), App.Path & "/winhost.ini")
227      filterManagerHostname = Left$(buf, length)
228      length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
229      filterManagerTCPPort = length
230 +    
231      If filterManagerHostname = "" Then
232          GoTo iniError
233      End If
234 +    
235 +    ' Resume normal error handling.
236      On Error GoTo 0
221 skip:
237  
238 +    ' We have the configuration.  Now connect.
239      Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
240      Reconfigure_Click
241      
242 +    ' Install the icon in the system tray.
243      SystemTray.Icon = Val(Form1.Icon)
244      SystemTray.Action = 0
245      
246      
247      Exit Sub
248      
249 + ' Error handler
250   iniError:
251      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")
252      End
253      
254   End Sub
255  
256 +
257 + ' Unload event.  Also fires when the machine is shutting down.
258   Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
259 +    
260 +    ' Prevent users from unwittingly shutting down thet winhost.
261      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")
262      If x = 7 Then
263          Cancel = True
264      Else
265 +        ' Remove the icon from the system tray.
266          SystemTray.Action = 2
267      End If
268  
269   End Sub
270  
271 +
272 + ' Make the form disappear and update the icon in the system tray.
273   Private Sub Hide_Click()
274      Form1.Visible = False
275      SystemTray.Icon = Val(Form1.Icon)
276   End Sub
277  
278  
279 + ' Reconfigure the host with the filter manager.
280   Private Sub Reconfigure_Click()
281 <    ' establish a TCP connection to a filtermanager
281 >    ' establish a TCP connection to a filtermanager, provided another TCP
282 >    ' communication is not already taking place.
283      If Not heartBeating Then
284          connected = False
285          TCPSock.Close
# Line 263 | Line 290 | Private Sub Reconfigure_Click()
290   End Sub
291  
292  
293 <
293 > ' Do this when the user double-clicks on the system tray icon.
294   Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
295 <
295 >    ' After double-clicking on the system tray icon, we make the
296 >    ' form visible and give it active focus.
297      Form1.Visible = True
298      Form1.SetFocus
299  
300   End Sub
301  
302 +
303 + ' Establish a connection with the filter manager.
304 + ' Thereafter, use the filter instead.
305   Private Sub TCPSock_Connect()
306      
307 +    ' Start from the first line of the response.
308      responseNumber = 0
309 <  
309 >    
310      ' Send something as soon as we connect to the server.
311      If connected = False Then
312          ' contact the FilterManager
# Line 286 | Line 318 | Private Sub TCPSock_Connect()
318    
319   End Sub
320  
321 +
322 + ' Deal with TCP traffic coming from the filter or filter manager.
323   Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
324      
325 +    ' Move to the next line of the response.
326      responseNumber = responseNumber + 1
327      
328      ' Get the line from the server.
# Line 311 | Line 346 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
346                  lastModified = response
347                  Text1.Text = Text1.Text & response & vbCrLf
348                  TCPSock.SendData "FILELIST" & vbCrLf
314            ' New addition to the protocol.
349              Case 3:
350                  If response = "ERROR" Then GoTo configError
351                  fileList = response
# Line 338 | Line 372 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
372                  TCPSock.SendData "FILTER" & vbCrLf
373              Case 8:
374                  Text1.Text = Text1.Text & response & vbCrLf
375 <                'we got a filter list here.
375 >                ' We got a filter list here.
376                  readTo = 0
377 <                ' get hostname
377 >                ' Get hostname
378                  readTo = InStr(1, response, ";", vbBinaryCompare)
379                  filterHostname = Mid(response, 1, readTo - 1)
380                  response = Mid(response, readTo + 1, Len(response))
381 <                ' get UDP Port number
381 >                ' Get UDP Port number
382                  readTo = InStr(1, response, ";")
383                  filterUDPPort = Mid(response, 1, readTo - 1)
384                  response = Mid(response, readTo + 1, Len(response))
385 <                ' get TCP Port number
385 >                ' Get TCP Port number
386                  filterTCPPort = response
387                  TCPSock.SendData "END" & vbCrLf
388              Case 9:
389                  If Not response = "OK" Then GoTo configError
390                  connected = True
391                  responseNumber = 0
392 +                ' We've finished with the socket now.
393                  TCPSock.Close
394                  Text1.Text = Text1.Text & response & vbCrLf
360                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
395                  Status.Caption = "Configuration successful"
396                  Label3.Caption = UDPUpdateTime
397                  Label4.Caption = TCPUpdateTime
# Line 382 | Line 416 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
416                  Text1.Text = Text1.Text & response & vbCrLf
417                  TCPSock.SendData lastModified & vbCrLf
418              Case 4:
419 +                ' Reconfigure if the server configuration for the
420 +                ' host has been altered.
421                  If Not response = "OK" Then
422                      heartBeating = False
423                      Reconfigure_Click
# Line 393 | Line 429 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
429                  Text1.Text = Text1.Text & response & vbCrLf
430                  TCPSock.Close
431                  Status.Caption = "Heartbeat sent successfully."
432 +                heartBeating = False
433          End Select
434      
435      End If
# Line 410 | Line 447 | heartbeatError:
447      Exit Sub
448   End Sub
449  
450 +
451 + ' Deal with the construction and sending of UDP packets.
452   Private Sub Timer1_Timer()
453  
454      Label3.Caption = Label3.Caption - 1
# Line 422 | Line 461 | Private Sub Timer1_Timer()
461          ' prepare the contents of the XML packet.
462          seqNo = seqNo + 1
463          
464 +        ' Windows machines can provide their NetBIOS name to assist
465 +        ' in identifying the machine.
466          netbiosName = TCPSock.LocalHostName
467          
468 +        ' The I.P. address of the host machine.
469          LocalIP = TCPSock.LocalIP
470 +        
471 +        ' The date according to the host machine (formatted as the
472 +        ' number of seconds since the epoch).
473          packetDate = Date2Num()
474          
475 <        
475 >        ' Attempt to return Windows version information with the API.
476          Dim verinfo As OSVERSIONINFO
477          verinfo.dwOSVersionInfoSize = Len(verinfo)
478          ret% = GetVersionEx(verinfo)
479          If ret% = 0 Then
480 <            MsgBox "Error getting Windows version Information"
480 >            Text1.Text = Text1.Text & vbCrLf & "Error getting Windows version Information"
481              End
482          End If
483            
484 +        ' Now get all of the version information.
485          osName = GetVersion()
486          osVersionMajor = verinfo.dwMajorVersion
487          osVersionMinor = verinfo.dwMinorVersion
488          osBuild = verinfo.dwBuildNumber
489          
490 +        ' Find out what type of processor the host is using.
491          Dim sysinfo As SYSTEM_INFO
492          GetSystemInfo sysinfo
493          Select Case sysinfo.dwProcessorType
# Line 458 | Line 505 | Private Sub Timer1_Timer()
505                  processorType = "(unknown)"
506          End Select
507          
508 +        ' Find the amount of swap memory and physical memory
509 +        ' (both free and total)
510          Dim memsts As MEMORYSTATUS
511          Dim memory&
512          GlobalMemoryStatus memsts
# Line 470 | Line 519 | Private Sub Timer1_Timer()
519          memory& = memsts.dwAvailVirtual
520          swapFree = memory& \ 1048576
521          
522 +        ' Cause the CUpTime class to capture its data.
523          CUpTime.Capture
524 +        
525 +        ' Get the processor occupancy percentages.
526          cpu_time = CUpTime.CPUTime
527          percent_idle = CUpTime.PercentIdle
528          
529 <        '' Doesn't work after 47 days :-/
530 <        'uptime = GetTickCount \ 1000
531 <        
480 <        'secondsRunning = secondsRunning + UDPUpdateTime
481 <        'uptime = secondsRunning
482 <        
529 >        ' Get the uptime for the host.  DO NOT use integer division here,
530 >        ' as this will cause the result to overflow if the machine has
531 >        ' been up for more than ~47 days.
532          uptime = CUpTime.MilliSecs / 1000#
533          
534 +        ' Use the CNetWksta class to find out how many users are logged
535 +        ' on to the system.
536          userCount = wksta.LoggedOnUsers
537          
538          ' build the contents of the XML packet
# Line 489 | Line 540 | Private Sub Timer1_Timer()
540                "<os>" & _
541                  "<netbios_name>" & netbiosName & "</netbios_name>" & _
542                  "<name>" & osName & "</name>" & _
543 <                "<version>" & osVersionMajor & "</version>" & _
543 >                "<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
544                  "<release>" & osBuild & "</release>" & _
545 <                "<platform>" & osName & "</platform>" & _
495 <                "<minor_version>" & osVersionMinor & "</minor_version>" & _
496 <                "<processor>" & processorType & "</processor>" & _
545 >                "<platform>" & processorType & "</platform>" & _
546                  "<uptime>" & uptime & "</uptime>" & _
547                "</os>" & _
548                "<users><count>" & userCount & "</count></users>" & _
# Line 501 | Line 550 | Private Sub Timer1_Timer()
550                "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
551                "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
552                "</packet>"
553 +        
554 +        ' Show the interested user what we are sending.
555          Text1.Text = "Last packet contained: -" & vbCrLf & xml
556  
557          ' Use the first winsock control to send a UDP packet.
# Line 520 | Line 571 | Private Sub Timer1_Timer()
571  
572   End Sub
573  
574 +
575 + ' Format the current date and time as a long integer representing
576 + ' the number of seconds since the epoch.
577   Function Date2Num() As Long
578      Dim x As Long
579      x = DateDiff("s", "1-1-1970", Now)

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines