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.3 by pjm2, Fri Feb 23 10:07:55 2001 UTC vs.
Revision 1.39 by pjm2, Thu Mar 22 09:27:04 2001 UTC

# Line 1 | Line 1
1   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     =   3  'Fixed Dialog
6 <   Caption         =   "TCP/UDP Test program"
7 <   ClientHeight    =   5655
6 >   Caption         =   "i-scream Winhost"
7 >   ClientHeight    =   1380
8     ClientLeft      =   45
9     ClientTop       =   330
10 <   ClientWidth     =   5670
10 >   ClientWidth     =   4635
11 >   Icon            =   "nettest.frx":0000
12     LinkTopic       =   "Form1"
13     MaxButton       =   0   'False
14     MinButton       =   0   'False
15 <   ScaleHeight     =   5655
16 <   ScaleWidth      =   5670
15 >   ScaleHeight     =   1380
16 >   ScaleWidth      =   4635
17     ShowInTaskbar   =   0   'False
18 <   StartUpPosition =   3  'Windows Default
19 <   Begin VB.CommandButton Command3
20 <      Caption         =   "TCP to Filter"
21 <      Height          =   375
22 <      Left            =   3720
23 <      TabIndex        =   9
24 <      Top             =   2520
25 <      Width           =   1575
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 Text4
29 <      Height          =   2535
30 <      Left            =   240
28 >   Begin VB.TextBox Text1
29 >      Height          =   2055
30 >      Left            =   120
31 >      Locked          =   -1  'True
32        MultiLine       =   -1  'True
33        ScrollBars      =   2  'Vertical
30      TabIndex        =   8
31      Text            =   "nettest.frx":0000
32      Top             =   3000
33      Width           =   5055
34   End
35   Begin VB.CommandButton Command2
36      Caption         =   "TCP to FilterManager"
37      Height          =   375
38      Left            =   3360
34        TabIndex        =   7
35 <      Top             =   2040
36 <      Width           =   1935
35 >      Top             =   1440
36 >      Width           =   4395
37     End
38 <   Begin MSWinsockLib.Winsock Winsock2
39 <      Left            =   4920
40 <      Top             =   120
41 <      _ExtentX        =   741
42 <      _ExtentY        =   741
43 <      _Version        =   393216
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 VB.TextBox Text3
47 <      Height          =   285
48 <      Left            =   1680
49 <      TabIndex        =   5
50 <      Text            =   "killigrew.ukc.ac.uk"
51 <      Top             =   1560
52 <      Width           =   2535
46 >   Begin SysTray.SystemTray SystemTray
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.TextBox Text2
55 <      Height          =   285
56 <      Left            =   1680
61 <      TabIndex        =   3
62 <      Text            =   "4567"
63 <      Top             =   1920
64 <      Width           =   855
54 >   Begin VB.Timer Timer1
55 >      Left            =   3120
56 >      Top             =   4200
57     End
58 <   Begin VB.CommandButton Command1
59 <      Caption         =   "Send UDP"
58 >   Begin VB.CommandButton Reconfigure
59 >      Caption         =   "Reconfigure with FilterManager"
60        Height          =   375
61 <      Left            =   4320
70 <      TabIndex        =   2
71 <      Top             =   1560
72 <      Width           =   975
73 <   End
74 <   Begin VB.TextBox Text1
75 <      Height          =   855
76 <      Left            =   360
61 >      Left            =   840
62        TabIndex        =   0
63 <      Text            =   "<packet></packet>"
64 <      Top             =   600
80 <      Width           =   4935
63 >      Top             =   3555
64 >      Width           =   2895
65     End
66 <   Begin MSWinsockLib.Winsock Winsock1
67 <      Left            =   4320
68 <      Top             =   120
66 >   Begin MSWinsockLib.Winsock TCPSock
67 >      Left            =   4080
68 >      Top             =   4200
69        _ExtentX        =   741
70        _ExtentY        =   741
71        _Version        =   393216
72 +   End
73 +   Begin MSWinsockLib.Winsock UDPSock
74 +      Left            =   3600
75 +      Top             =   4200
76 +      _ExtentX        =   741
77 +      _ExtentY        =   741
78 +      _Version        =   393216
79        Protocol        =   1
80     End
81 <   Begin VB.Label Label3
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         =   "Destination:"
90 >      Caption         =   "Next heartbeat:"
91        Height          =   255
92 <      Left            =   360
93 <      TabIndex        =   6
94 <      Top             =   1560
95 <      Width           =   1215
92 >      Left            =   120
93 >      TabIndex        =   5
94 >      Top             =   645
95 >      Width           =   1455
96     End
97 <   Begin VB.Label Label2
97 >   Begin VB.Label Label1
98        Alignment       =   1  'Right Justify
99 <      Caption         =   "Port:"
99 >      Caption         =   "Next UDP packet:"
100        Height          =   255
101 <      Left            =   360
101 >      Left            =   120
102        TabIndex        =   4
103 <      Top             =   1920
104 <      Width           =   1215
103 >      Top             =   165
104 >      Width           =   1455
105     End
106 <   Begin VB.Label Label1
107 <      Caption         =   "Packet contents"
106 >   Begin VB.Label Label4
107 >      BorderStyle     =   1  'Fixed Single
108 >      Caption         =   "0"
109        Height          =   255
110 <      Left            =   360
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            =   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            =   0
129        TabIndex        =   1
130 <      Top             =   360
131 <      Width           =   2895
130 >      Top             =   1035
131 >      Width           =   3180
132     End
133   End
134   Attribute VB_Name = "Form1"
# Line 119 | 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 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 + ' 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 + ' Keep track of the line number in TCP communications.
180   Dim responseNumber As Integer
181  
182  
183 + ' Toggle visibility of the debug output.
184   Private Sub Command1_Click()
185 +    If windowBig Then
186 +        Form1.Height = 1755
187 +        windowBig = False
188 +    Else
189 +        Form1.Height = 4380
190 +        windowBig = True
191 +    End If
192 + End Sub
193  
135    ' Use the first winsock control to send a UDP packet.
136    Winsock1.RemoteHost = Text3.Text
137    Winsock1.RemotePort = Text2.Text
138    Winsock1.SendData Text1.Text
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 +    
204 +    protocolVersion = "1.1"
205 +    
206 +    Status.Caption = "Loading"
207 +    Form1.Caption = "i-scream Winhost " & protocolVersion
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 +    ' 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", "", 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
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 < Private Sub Command2_Click()
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 <    ' establish a TCP connection to a filtermanager
261 <    Winsock2.Close
262 <    Winsock2.Connect Text3.Text, Text2.Text
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 < Private Sub Command3_Click()
272 <    ' establish a TCP connection to a filter
273 <    Winsock2.Close
274 <    Winsock2.Connect filterHostname, filterTCPPort
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 < Private Sub Form_Load()
279 <    protocolVersion = "1.1"
278 >
279 > ' Reconfigure the host with the filter manager.
280 > Private Sub Reconfigure_Click()
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
286 >        TCPSock.Connect filterManagerHostname, filterManagerTCPPort
287 >    Else
288 >        Status.Caption = "Cannot reconfigure while heartbeating"
289 >    End If
290   End Sub
291  
292 < Private Sub Winsock2_Connect()
293 <      
294 <   responseNumber = 0
295 <  
292 >
293 > ' Do this when the user double-clicks on the system tray icon.
294 > Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
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 >    
310      ' Send something as soon as we connect to the server.
311      If connected = False Then
312          ' contact the FilterManager
313 <        Winsock2.SendData "STARTCONFIG" & vbCrLf
313 >        TCPSock.SendData "STARTCONFIG" & vbCrLf
314      Else
315         ' Contact the Filter
316 <       Winsock2.SendData "HEARTBEAT" & vbCrLf
316 >       TCPSock.SendData "HEARTBEAT" & vbCrLf
317      End If
318    
319   End Sub
320  
321 < Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
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.
329 <    Winsock2.GetData response, vbString, bytesTotal
329 >    TCPSock.GetData response, vbString, bytesTotal
330      
331      ' Remove linefeeds and returns from the line.
332      response = Replace(response, Chr(13), "")
333      response = Replace(response, Chr(10), "")
185    Text4.Text = Text4.Text & vbCrLf & response
334      
335      If connected = False Then
336          ' Perform TCP configuration (1.1)
# Line 190 | Line 338 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
338          Select Case responseNumber
339              Case 1:
340                  If Not response = "OK" Then GoTo configError
341 <                Winsock2.SendData "LASTMODIFIED" & vbCrLf
341 >                TCPSock.SendData "LASTMODIFIED" & vbCrLf
342 >                Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
343 >                Text1.Text = Text1.Text & response & vbCrLf
344              Case 2:
345                  If response = "ERROR" Then GoTo configError
346                  lastModified = response
347 <                Winsock2.SendData "FILELIST" & vbCrLf
347 >                Text1.Text = Text1.Text & response & vbCrLf
348 >                TCPSock.SendData "FILELIST" & vbCrLf
349              Case 3:
350                  If response = "ERROR" Then GoTo configError
351                  fileList = response
352 <                Winsock2.SendData "UDPUpdateTime" & vbCrLf
352 >                Text1.Text = Text1.Text & response & vbCrLf
353 >                TCPSock.SendData "FQDN" & vbCrLf
354              Case 4:
355                  If response = "ERROR" Then GoTo configError
356 <                Winsock2.SendData "TCPUpdateTime" & vbCrLf
356 >                Text1.Text = Text1.Text & response & vbCrLf
357 >                machineName = response
358 >                TCPSock.SendData "UDPUpdateTime" & vbCrLf
359              Case 5:
360                  If response = "ERROR" Then GoTo configError
361 <                Winsock2.SendData "ENDCONFIG" & vbCrLf
361 >                UDPUpdateTime = response
362 >                Text1.Text = Text1.Text & response & vbCrLf
363 >                TCPSock.SendData "TCPUpdateTime" & vbCrLf
364              Case 6:
365 <                If Not response = "OK" Then GoTo configError
366 <                Winsock2.SendData "FILTER" & vbCrLf
365 >                If response = "ERROR" Then GoTo configError
366 >                TCPUpdateTime = response
367 >                Text1.Text = Text1.Text & response & vbCrLf
368 >                TCPSock.SendData "ENDCONFIG" & vbCrLf
369              Case 7:
370 <                'we got a filter list here.
370 >                If Not response = "OK" Then GoTo configError
371 >                Text1.Text = Text1.Text & response & vbCrLf
372 >                TCPSock.SendData "FILTER" & vbCrLf
373 >            Case 8:
374 >                Text1.Text = Text1.Text & response & vbCrLf
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 <                Winsock2.SendData "END" & vbCrLf
388 <            Case 8:
387 >                TCPSock.SendData "END" & vbCrLf
388 >            Case 9:
389                  If Not response = "OK" Then GoTo configError
390                  connected = True
391                  responseNumber = 0
392 <                Winsock2.Close
393 <                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
394 <                x = MsgBox("got config okay")
392 >                ' We've finished with the socket now.
393 >                TCPSock.Close
394 >                Text1.Text = Text1.Text & response & vbCrLf
395 >                Status.Caption = "Configuration successful"
396 >                Label3.Caption = UDPUpdateTime
397 >                Label4.Caption = TCPUpdateTime
398 >                Timer1.Interval = 1000
399          End Select
400      Else
401          ' Perform a heartbeat (1.1)
402 +        heartBeating = True
403          On Error GoTo heartbeatError
404          Select Case responseNumber
405              Case 1:
406                  If Not response = "OK" Then GoTo heartbeatError
407 <                Winsock2.SendData "CONFIG" & vbCrLf
407 >                Text1.Text = "Performing heartbeat: -" & vbCrLf
408 >                Text1.Text = Text1.Text & response & vbCrLf
409 >                TCPSock.SendData "CONFIG" & vbCrLf
410              Case 2:
411                  If Not response = "OK" Then GoTo heartbeatError
412 <                Winsock2.SendData fileList & vbCrLf
412 >                Text1.Text = Text1.Text & response & vbCrLf
413 >                TCPSock.SendData fileList & vbCrLf
414              Case 3:
415                  If Not response = "OK" Then GoTo heartbeatError
416 <                Winsock2.SendData lastModified & vbCrLf
416 >                Text1.Text = Text1.Text & response & vbCrLf
417 >                TCPSock.SendData lastModified & vbCrLf
418              Case 4:
419 <                If Not response = "OK" Then GoTo heartbeatError
420 <                Winsock2.SendData "ENDHEARTBEAT" & vbCrLf
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
424 >                End If
425 >                Text1.Text = Text1.Text & response & vbCrLf
426 >                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
427              Case 5:
428                  If Not response = "OK" Then GoTo heartbeatError
429 <                Winsock2.Close
430 <                x = MsgBox("heartbeat sent okay.")
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 258 | Line 438 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
438      Exit Sub
439      
440   configError:
441 <    x = MsgBox("error doing configuration")
441 >    heartBeating = False
442 >    Status.Caption = "FAILED to get configuration from the server"
443 >    Exit Sub
444   heartbeatError:
445 +    heartBeating = False
446 +    Status.Caption = "Heatbeat FAILED"
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
455 +    Label4.Caption = Label4.Caption - 1
456      
457 +    Status.Caption = ""
458 +    
459 +    If Label3.Caption < 1 Then
460 +        
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 +        ' 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 +            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
494 +            Case PROCESSOR_INTEL_386
495 +                processorType = "Intel 386"
496 +            Case PROCESSOR_INTEL_486
497 +                processorType = "Intel 486"
498 +            Case PROCESSOR_INTEL_PENTIUM
499 +                processorType = "Intel Pentium variant"
500 +            Case PROCESSOR_MIPS_R4000
501 +                processorType = "MIPS R4000"
502 +            Case PROCESSOR_ALPHA_21064
503 +                processorType = "DEC Alpha 21064"
504 +            Case Else
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
513 +        memory& = memsts.dwTotalPhys
514 +        memTotal = memory& \ 1048576
515 +        memory& = memsts.dwAvailPhys
516 +        memFree = memory& \ 1048576
517 +        memory& = memsts.dwTotalVirtual
518 +        swapTotal = memory& \ 1048576
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 +        ' 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
539 +        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
540 +              "<os>" & _
541 +                "<netbios_name>" & netbiosName & "</netbios_name>" & _
542 +                "<name>" & osName & "</name>" & _
543 +                "<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
544 +                "<release>" & osBuild & "</release>" & _
545 +                "<platform>" & processorType & "</platform>" & _
546 +                "<uptime>" & uptime & "</uptime>" & _
547 +              "</os>" & _
548 +              "<users><count>" & userCount & "</count></users>" & _
549 +              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
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.
558 +        UDPSock.RemoteHost = filterHostname
559 +        UDPSock.RemotePort = filterUDPPort
560 +        UDPSock.SendData xml
561 +        Status.Caption = "UDP packet sent"
562 +        Label3.Caption = UDPUpdateTime
563 +    End If
564 +    
565 +    If Label4.Caption < 1 Then
566 +        ' establish a TCP connection to a filter
567 +        TCPSock.Close
568 +        TCPSock.Connect filterHostname, filterTCPPort
569 +        Label4.Caption = TCPUpdateTime
570 +    End If
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)
580 +    Date2Num = x
581 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines