| 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 = 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 = 5670 |
| 9 |
> |
ClientTop = 330 |
| 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.Timer Timer1 |
| 20 |
< |
Left = 4200 |
| 21 |
< |
Top = 1200 |
| 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 = 1575 |
| 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 |
| 34 |
< |
TabIndex = 1 |
| 35 |
< |
Text = "nettest.frx":0000 |
| 36 |
< |
Top = 3000 |
| 29 |
< |
Width = 5055 |
| 34 |
> |
TabIndex = 7 |
| 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 = 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 = 3120 |
| 56 |
+ |
Top = 4200 |
| 57 |
+ |
End |
| 58 |
|
Begin VB.CommandButton Reconfigure |
| 59 |
|
Caption = "Reconfigure with FilterManager" |
| 60 |
< |
Height = 495 |
| 61 |
< |
Left = 120 |
| 60 |
> |
Height = 375 |
| 61 |
> |
Left = 840 |
| 62 |
|
TabIndex = 0 |
| 63 |
< |
Top = 120 |
| 63 |
> |
Top = 3555 |
| 64 |
|
Width = 2895 |
| 65 |
|
End |
| 66 |
|
Begin MSWinsockLib.Winsock TCPSock |
| 67 |
< |
Left = 5160 |
| 68 |
< |
Top = 1200 |
| 67 |
> |
Left = 4080 |
| 68 |
> |
Top = 4200 |
| 69 |
|
_ExtentX = 741 |
| 70 |
|
_ExtentY = 741 |
| 71 |
|
_Version = 393216 |
| 72 |
|
End |
| 73 |
|
Begin MSWinsockLib.Winsock UDPSock |
| 74 |
< |
Left = 4680 |
| 75 |
< |
Top = 1200 |
| 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 = 3360 |
| 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 = 3360 |
| 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 = 4920 |
| 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 = 4920 |
| 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 = 840 |
| 131 |
< |
Width = 5415 |
| 128 |
> |
Left = 0 |
| 129 |
> |
TabIndex = 1 |
| 130 |
> |
Top = 1035 |
| 131 |
> |
Width = 3180 |
| 132 |
|
End |
| 133 |
|
End |
| 134 |
|
Attribute VB_Name = "Form1" |
| 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 Integer |
| 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 responseNumber As Integer |
| 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 |
< |
Private Sub Command1_Click() |
| 179 |
> |
' Keep track of the line number in TCP communications. |
| 180 |
> |
Dim responseNumber As Integer |
| 181 |
|
|
| 126 |
– |
' build the contents of the XML packet. |
| 127 |
– |
xml = "<packet></packet>" |
| 182 |
|
|
| 183 |
< |
' Use the first winsock control to send a UDP packet. |
| 184 |
< |
UDPSock.RemoteHost = filterHostname |
| 185 |
< |
UDPSock.RemotePort = filterUDPPort |
| 186 |
< |
UDPSock.SendData xml |
| 187 |
< |
Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent." |
| 188 |
< |
|
| 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 |
|
|
| 194 |
|
|
| 195 |
< |
Private Sub Command3_Click() |
| 139 |
< |
' establish a TCP connection to a filter |
| 140 |
< |
TCPSock.Close |
| 141 |
< |
TCPSock.Connect filterHostname, filterTCPPort |
| 142 |
< |
End Sub |
| 143 |
< |
|
| 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 |
< |
|
| 205 |
> |
|
| 206 |
|
Status.Caption = "Loading" |
| 207 |
|
Form1.Caption = "i-scream Winhost " & protocolVersion |
| 208 |
|
|
| 209 |
< |
''''TEMP |
| 151 |
< |
filterManagerHostname = "killigrew.ukc.ac.uk" |
| 152 |
< |
filterManagerTCPPort = 4567 |
| 153 |
< |
Reconfigure_Click |
| 154 |
< |
Exit Sub |
| 155 |
< |
''' ENDTEMP |
| 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", "<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 = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini") |
| 229 |
< |
filterManagerTCPPort = Left$(buf, length) |
| 228 |
> |
length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini") |
| 229 |
> |
filterManagerTCPPort = length |
| 230 |
|
|
| 231 |
< |
Status.Caption = "Connecting to Filter Manager" |
| 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.", 48, "Configuration not found") |
| 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 |
< |
x = MsgBox("Are you sure you want to shut down the Winhost?", vbYesNo, "i-scream Winhost") |
| 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 |
| 282 |
< |
connected = False |
| 283 |
< |
TCPSock.Close |
| 284 |
< |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
| 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 |
+ |
|
| 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 |
< |
|
| 309 |
> |
|
| 310 |
|
' Send something as soon as we connect to the server. |
| 311 |
|
If connected = False Then |
| 312 |
|
' contact the FilterManager |
| 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. |
| 331 |
|
' Remove linefeeds and returns from the line. |
| 332 |
|
response = Replace(response, Chr(13), "") |
| 333 |
|
response = Replace(response, Chr(10), "") |
| 215 |
– |
Text4.Text = Text4.Text & vbCrLf & response |
| 334 |
|
|
| 335 |
|
If connected = False Then |
| 336 |
|
' Perform TCP configuration (1.1) |
| 339 |
|
Case 1: |
| 340 |
|
If Not response = "OK" Then GoTo configError |
| 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 |
+ |
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 |
< |
TCPSock.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 |
+ |
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 |
|
UDPUpdateTime = response |
| 362 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 363 |
|
TCPSock.SendData "TCPUpdateTime" & vbCrLf |
| 364 |
< |
Case 5: |
| 364 |
> |
Case 6: |
| 365 |
|
If response = "ERROR" Then GoTo configError |
| 366 |
|
TCPUpdateTime = response |
| 367 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 368 |
|
TCPSock.SendData "ENDCONFIG" & vbCrLf |
| 369 |
< |
Case 6: |
| 369 |
> |
Case 7: |
| 370 |
|
If Not response = "OK" Then GoTo configError |
| 371 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 372 |
|
TCPSock.SendData "FILTER" & vbCrLf |
| 373 |
< |
Case 7: |
| 374 |
< |
'we got a filter list here. |
| 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 |
|
TCPSock.SendData "END" & vbCrLf |
| 388 |
< |
Case 8: |
| 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 |
< |
Text4.Text = Text4.Text & vbCrLf & " <closed>" |
| 394 |
> |
Text1.Text = Text1.Text & response & vbCrLf |
| 395 |
|
Status.Caption = "Configuration successful" |
| 396 |
|
Label3.Caption = UDPUpdateTime |
| 397 |
|
Label4.Caption = TCPUpdateTime |
| 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 |
+ |
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 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 413 |
|
TCPSock.SendData fileList & vbCrLf |
| 414 |
|
Case 3: |
| 415 |
|
If Not response = "OK" Then GoTo heartbeatError |
| 416 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 417 |
|
TCPSock.SendData lastModified & vbCrLf |
| 418 |
|
Case 4: |
| 419 |
< |
If Not response = "OK" Then GoTo heartbeatError |
| 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 |
+ |
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 |
| 438 |
|
Exit Sub |
| 439 |
|
|
| 440 |
|
configError: |
| 441 |
< |
Status.Caption = "FAILED to get 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 |
| 457 |
|
Status.Caption = "" |
| 458 |
|
|
| 459 |
|
If Label3.Caption < 1 Then |
| 460 |
< |
' build the contents of the XML packet. |
| 461 |
< |
xml = "<packet></packet>" |
| 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 |
| 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 |
