| 2 |
|
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" |
| 3 |
|
Object = "{33155A3D-0CE0-11D1-A6B4-444553540000}#1.0#0"; "SysTray.ocx" |
| 4 |
|
Begin VB.Form Form1 |
| 5 |
< |
BorderStyle = 4 'Fixed ToolWindow |
| 5 |
> |
BorderStyle = 3 'Fixed Dialog |
| 6 |
|
Caption = "i-scream Winhost" |
| 7 |
< |
ClientHeight = 5655 |
| 7 |
> |
ClientHeight = 1185 |
| 8 |
|
ClientLeft = 45 |
| 9 |
< |
ClientTop = 285 |
| 10 |
< |
ClientWidth = 5670 |
| 9 |
> |
ClientTop = 330 |
| 10 |
> |
ClientWidth = 4710 |
| 11 |
> |
Icon = "nettest.frx":0000 |
| 12 |
|
LinkTopic = "Form1" |
| 13 |
|
MaxButton = 0 'False |
| 14 |
< |
ScaleHeight = 5655 |
| 15 |
< |
ScaleWidth = 5670 |
| 14 |
> |
MinButton = 0 'False |
| 15 |
> |
ScaleHeight = 1185 |
| 16 |
> |
ScaleWidth = 4710 |
| 17 |
|
ShowInTaskbar = 0 'False |
| 18 |
< |
StartUpPosition = 3 'Windows Default |
| 19 |
< |
Begin VB.CommandButton Hide |
| 20 |
< |
Caption = "Hide" |
| 21 |
< |
Height = 495 |
| 22 |
< |
Left = 1800 |
| 18 |
> |
StartUpPosition = 2 'CenterScreen |
| 19 |
> |
Visible = 0 'False |
| 20 |
> |
Begin VB.CommandButton Command1 |
| 21 |
> |
Caption = "more" |
| 22 |
> |
Height = 255 |
| 23 |
> |
Left = 3960 |
| 24 |
> |
TabIndex = 8 |
| 25 |
> |
Top = 840 |
| 26 |
> |
Width = 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 = 2160 |
| 36 |
< |
Width = 1215 |
| 35 |
> |
Top = 1200 |
| 36 |
> |
Width = 4455 |
| 37 |
|
End |
| 38 |
+ |
Begin VB.CommandButton Hide |
| 39 |
+ |
Caption = "hide" |
| 40 |
+ |
Height = 255 |
| 41 |
+ |
Left = 3960 |
| 42 |
+ |
TabIndex = 6 |
| 43 |
+ |
Top = 480 |
| 44 |
+ |
Width = 615 |
| 45 |
+ |
End |
| 46 |
|
Begin SysTray.SystemTray SystemTray |
| 47 |
< |
Left = 3600 |
| 48 |
< |
Top = 1200 |
| 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 = 4200 |
| 56 |
< |
Top = 1200 |
| 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 = 5055 |
| 46 |
– |
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 = 3480 |
| 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 |
| 82 |
|
Alignment = 1 'Right Justify |
| 83 |
|
Caption = "Next heartbeat:" |
| 84 |
|
Height = 255 |
| 85 |
< |
Left = 3360 |
| 86 |
< |
TabIndex = 6 |
| 85 |
> |
Left = 120 |
| 86 |
> |
TabIndex = 5 |
| 87 |
|
Top = 480 |
| 88 |
|
Width = 1455 |
| 89 |
|
End |
| 91 |
|
Alignment = 1 'Right Justify |
| 92 |
|
Caption = "Next UDP packet:" |
| 93 |
|
Height = 255 |
| 94 |
< |
Left = 3360 |
| 95 |
< |
TabIndex = 5 |
| 94 |
> |
Left = 120 |
| 95 |
> |
TabIndex = 4 |
| 96 |
|
Top = 120 |
| 97 |
|
Width = 1455 |
| 98 |
|
End |
| 100 |
|
BorderStyle = 1 'Fixed Single |
| 101 |
|
Caption = "0" |
| 102 |
|
Height = 255 |
| 103 |
< |
Left = 4920 |
| 104 |
< |
TabIndex = 4 |
| 103 |
> |
Left = 1680 |
| 104 |
> |
TabIndex = 3 |
| 105 |
|
Top = 480 |
| 106 |
|
Width = 615 |
| 107 |
|
End |
| 109 |
|
BorderStyle = 1 'Fixed Single |
| 110 |
|
Caption = "0" |
| 111 |
|
Height = 255 |
| 112 |
< |
Left = 4920 |
| 113 |
< |
TabIndex = 3 |
| 112 |
> |
Left = 1680 |
| 113 |
> |
TabIndex = 2 |
| 114 |
|
Top = 120 |
| 115 |
|
Width = 615 |
| 116 |
|
End |
| 117 |
|
Begin VB.Label Status |
| 118 |
+ |
Alignment = 2 'Center |
| 119 |
|
Caption = "Status:" |
| 120 |
|
Height = 255 |
| 121 |
< |
Left = 120 |
| 122 |
< |
TabIndex = 2 |
| 121 |
> |
Left = 0 |
| 122 |
> |
TabIndex = 1 |
| 123 |
|
Top = 840 |
| 124 |
< |
Width = 5415 |
| 124 |
> |
Width = 3855 |
| 125 |
|
End |
| 126 |
|
End |
| 127 |
|
Attribute VB_Name = "Form1" |
| 129 |
|
Attribute VB_Creatable = False |
| 130 |
|
Attribute VB_PredeclaredId = True |
| 131 |
|
Attribute VB_Exposed = False |
| 132 |
+ |
' For the system tray bits |
| 133 |
|
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 |
| 134 |
|
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long |
| 135 |
|
|
| 136 |
|
Dim filterManagerHostname As String |
| 137 |
< |
Dim filterManagerTCPPort As Integer |
| 137 |
> |
Dim filterManagerTCPPort As Long |
| 138 |
|
|
| 139 |
+ |
Dim seqNo As Long |
| 140 |
+ |
Dim machineName As String |
| 141 |
+ |
|
| 142 |
+ |
Dim secondsRunning As Long |
| 143 |
+ |
|
| 144 |
|
Dim filterHostname As String |
| 145 |
|
Dim filterTCPPort As Integer |
| 146 |
|
Dim filterUDPPort As Integer |
| 147 |
|
Dim fileList As String |
| 148 |
|
Dim lastModified As String |
| 149 |
|
|
| 150 |
+ |
Dim fourtySevenDays As Integer |
| 151 |
+ |
|
| 152 |
|
Dim UDPUpdateTime As Integer |
| 153 |
|
Dim TCPUpdateTime As Integer |
| 154 |
|
|
| 155 |
|
Dim protocolVersion As String |
| 156 |
|
Dim connected As Boolean |
| 157 |
< |
Dim responseNumber As Integer |
| 157 |
> |
Dim heartBeating As Boolean |
| 158 |
|
|
| 159 |
+ |
Dim CUpTime As New CUpTime |
| 160 |
+ |
Dim wksta As New CNetWksta |
| 161 |
|
|
| 162 |
< |
Private Sub Command1_Click() |
| 162 |
> |
Dim windowBig As Boolean |
| 163 |
|
|
| 164 |
< |
' build the contents of the XML packet. |
| 143 |
< |
xml = "<packet></packet>" |
| 164 |
> |
Dim responseNumber As Integer |
| 165 |
|
|
| 166 |
< |
' Use the first winsock control to send a UDP packet. |
| 146 |
< |
UDPSock.RemoteHost = filterHostname |
| 147 |
< |
UDPSock.RemotePort = filterUDPPort |
| 148 |
< |
UDPSock.SendData xml |
| 149 |
< |
Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent." |
| 166 |
> |
Private Sub Command1_Click() |
| 167 |
|
|
| 168 |
< |
End Sub |
| 168 |
> |
' Toggle visibility of the debug output. |
| 169 |
|
|
| 170 |
+ |
If windowBig Then |
| 171 |
+ |
Form1.Height = 1500 |
| 172 |
+ |
windowBig = False |
| 173 |
+ |
Else |
| 174 |
+ |
Form1.Height = 4350 |
| 175 |
+ |
windowBig = True |
| 176 |
+ |
End If |
| 177 |
|
|
| 154 |
– |
Private Sub Command3_Click() |
| 155 |
– |
' establish a TCP connection to a filter |
| 156 |
– |
TCPSock.Close |
| 157 |
– |
TCPSock.Connect filterHostname, filterTCPPort |
| 178 |
|
End Sub |
| 179 |
|
|
| 180 |
|
Private Sub Form_Load() |
| 181 |
+ |
|
| 182 |
+ |
If App.PrevInstance Then |
| 183 |
+ |
x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running") |
| 184 |
+ |
End |
| 185 |
+ |
End If |
| 186 |
+ |
|
| 187 |
+ |
' Assume the host is run within the first 47 days of the machine starting. |
| 188 |
+ |
fourtySevenDays = 0 |
| 189 |
+ |
|
| 190 |
|
protocolVersion = "1.1" |
| 191 |
< |
|
| 191 |
> |
|
| 192 |
|
Status.Caption = "Loading" |
| 193 |
|
Form1.Caption = "i-scream Winhost " & protocolVersion |
| 194 |
|
|
| 195 |
+ |
CUpTime.Init |
| 196 |
+ |
|
| 197 |
+ |
If CUpTime.isWin9x Then |
| 198 |
+ |
x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server") |
| 199 |
+ |
End |
| 200 |
+ |
End If |
| 201 |
+ |
|
| 202 |
+ |
windowBig = False |
| 203 |
+ |
|
| 204 |
|
''''TEMP |
| 205 |
< |
filterManagerHostname = "killigrew.ukc.ac.uk" |
| 206 |
< |
filterManagerTCPPort = 4567 |
| 207 |
< |
Reconfigure_Click |
| 170 |
< |
Exit Sub |
| 171 |
< |
''' ENDTEMP |
| 205 |
> |
'filterManagerHostname = "killigrew.ukc.ac.uk" |
| 206 |
> |
'filterManagerTCPPort = 4567 |
| 207 |
> |
''''' END TEMP |
| 208 |
|
|
| 209 |
+ |
'GoTo skip |
| 210 |
|
On Error GoTo iniError |
| 211 |
|
Dim buf As String * 256 |
| 212 |
|
Dim length As Long |
| 213 |
< |
length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini") |
| 213 |
> |
length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini") |
| 214 |
|
filterManagerHostname = Left$(buf, length) |
| 215 |
< |
length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini") |
| 216 |
< |
filterManagerTCPPort = Left$(buf, length) |
| 215 |
> |
length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini") |
| 216 |
> |
filterManagerTCPPort = length |
| 217 |
> |
If filterManagerHostname = "" Then |
| 218 |
> |
GoTo iniError |
| 219 |
> |
End If |
| 220 |
> |
On Error GoTo 0 |
| 221 |
> |
skip: |
| 222 |
> |
|
| 223 |
> |
Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort |
| 224 |
> |
Reconfigure_Click |
| 225 |
|
|
| 226 |
< |
Status.Caption = "Connecting to Filter Manager" |
| 226 |
> |
SystemTray.Icon = Val(Form1.Icon) |
| 227 |
> |
SystemTray.Action = 0 |
| 228 |
|
|
| 229 |
+ |
|
| 230 |
|
Exit Sub |
| 231 |
|
|
| 232 |
|
iniError: |
| 233 |
< |
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") |
| 233 |
> |
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") |
| 234 |
|
End |
| 235 |
|
|
| 236 |
|
End Sub |
| 239 |
|
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") |
| 240 |
|
If x = 7 Then |
| 241 |
|
Cancel = True |
| 242 |
+ |
Else |
| 243 |
+ |
SystemTray.Action = 2 |
| 244 |
|
End If |
| 245 |
|
|
| 246 |
|
End Sub |
| 248 |
|
Private Sub Hide_Click() |
| 249 |
|
Form1.Visible = False |
| 250 |
|
SystemTray.Icon = Val(Form1.Icon) |
| 202 |
– |
SystemTray.Action = 0 |
| 251 |
|
End Sub |
| 252 |
|
|
| 253 |
+ |
|
| 254 |
|
Private Sub Reconfigure_Click() |
| 255 |
|
' establish a TCP connection to a filtermanager |
| 256 |
< |
connected = False |
| 257 |
< |
TCPSock.Close |
| 258 |
< |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
| 256 |
> |
If Not heartBeating Then |
| 257 |
> |
connected = False |
| 258 |
> |
TCPSock.Close |
| 259 |
> |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
| 260 |
> |
Else |
| 261 |
> |
Status.Caption = "Cannot reconfigure while heartbeating" |
| 262 |
> |
End If |
| 263 |
|
End Sub |
| 264 |
|
|
| 265 |
|
|
| 296 |
|
' Remove linefeeds and returns from the line. |
| 297 |
|
response = Replace(response, Chr(13), "") |
| 298 |
|
response = Replace(response, Chr(10), "") |
| 246 |
– |
Text4.Text = Text4.Text & vbCrLf & response |
| 299 |
|
|
| 300 |
|
If connected = False Then |
| 301 |
|
' Perform TCP configuration (1.1) |
| 304 |
|
Case 1: |
| 305 |
|
If Not response = "OK" Then GoTo configError |
| 306 |
|
TCPSock.SendData "LASTMODIFIED" & vbCrLf |
| 307 |
+ |
Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf |
| 308 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 309 |
|
Case 2: |
| 310 |
|
If response = "ERROR" Then GoTo configError |
| 311 |
|
lastModified = response |
| 312 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 313 |
|
TCPSock.SendData "FILELIST" & vbCrLf |
| 314 |
+ |
' New addition to the protocol. |
| 315 |
|
Case 3: |
| 316 |
|
If response = "ERROR" Then GoTo configError |
| 317 |
|
fileList = response |
| 318 |
< |
TCPSock.SendData "UDPUpdateTime" & vbCrLf |
| 318 |
> |
Text1.Text = Text1.Text & response & vbCrLf |
| 319 |
> |
TCPSock.SendData "FQDN" & vbCrLf |
| 320 |
|
Case 4: |
| 321 |
|
If response = "ERROR" Then GoTo configError |
| 322 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 323 |
+ |
machineName = response |
| 324 |
+ |
TCPSock.SendData "UDPUpdateTime" & vbCrLf |
| 325 |
+ |
Case 5: |
| 326 |
+ |
If response = "ERROR" Then GoTo configError |
| 327 |
|
UDPUpdateTime = response |
| 328 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 329 |
|
TCPSock.SendData "TCPUpdateTime" & vbCrLf |
| 330 |
< |
Case 5: |
| 330 |
> |
Case 6: |
| 331 |
|
If response = "ERROR" Then GoTo configError |
| 332 |
|
TCPUpdateTime = response |
| 333 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 334 |
|
TCPSock.SendData "ENDCONFIG" & vbCrLf |
| 335 |
< |
Case 6: |
| 335 |
> |
Case 7: |
| 336 |
|
If Not response = "OK" Then GoTo configError |
| 337 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 338 |
|
TCPSock.SendData "FILTER" & vbCrLf |
| 339 |
< |
Case 7: |
| 339 |
> |
Case 8: |
| 340 |
> |
Text1.Text = Text1.Text & response & vbCrLf |
| 341 |
|
'we got a filter list here. |
| 342 |
|
readTo = 0 |
| 343 |
|
' get hostname |
| 351 |
|
' get TCP Port number |
| 352 |
|
filterTCPPort = response |
| 353 |
|
TCPSock.SendData "END" & vbCrLf |
| 354 |
< |
Case 8: |
| 354 |
> |
Case 9: |
| 355 |
|
If Not response = "OK" Then GoTo configError |
| 356 |
|
connected = True |
| 357 |
|
responseNumber = 0 |
| 358 |
|
TCPSock.Close |
| 359 |
< |
Text4.Text = Text4.Text & vbCrLf & " <closed>" |
| 359 |
> |
Text1.Text = Text1.Text & response & vbCrLf |
| 360 |
> |
'Text4.Text = Text4.Text & vbCrLf & " <closed>" |
| 361 |
|
Status.Caption = "Configuration successful" |
| 362 |
|
Label3.Caption = UDPUpdateTime |
| 363 |
|
Label4.Caption = TCPUpdateTime |
| 365 |
|
End Select |
| 366 |
|
Else |
| 367 |
|
' Perform a heartbeat (1.1) |
| 368 |
+ |
heartBeating = True |
| 369 |
|
On Error GoTo heartbeatError |
| 370 |
|
Select Case responseNumber |
| 371 |
|
Case 1: |
| 372 |
|
If Not response = "OK" Then GoTo heartbeatError |
| 373 |
+ |
Text1.Text = "Performing heartbeat: -" & vbCrLf |
| 374 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 375 |
|
TCPSock.SendData "CONFIG" & vbCrLf |
| 376 |
|
Case 2: |
| 377 |
|
If Not response = "OK" Then GoTo heartbeatError |
| 378 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 379 |
|
TCPSock.SendData fileList & vbCrLf |
| 380 |
|
Case 3: |
| 381 |
|
If Not response = "OK" Then GoTo heartbeatError |
| 382 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 383 |
|
TCPSock.SendData lastModified & vbCrLf |
| 384 |
|
Case 4: |
| 385 |
< |
If Not response = "OK" Then GoTo heartbeatError |
| 385 |
> |
If Not response = "OK" Then |
| 386 |
> |
heartBeating = False |
| 387 |
> |
Reconfigure_Click |
| 388 |
> |
End If |
| 389 |
> |
Text1.Text = Text1.Text & response & vbCrLf |
| 390 |
|
TCPSock.SendData "ENDHEARTBEAT" & vbCrLf |
| 391 |
|
Case 5: |
| 392 |
|
If Not response = "OK" Then GoTo heartbeatError |
| 393 |
+ |
Text1.Text = Text1.Text & response & vbCrLf |
| 394 |
|
TCPSock.Close |
| 395 |
|
Status.Caption = "Heartbeat sent successfully." |
| 396 |
|
End Select |
| 401 |
|
Exit Sub |
| 402 |
|
|
| 403 |
|
configError: |
| 404 |
< |
Status.Caption = "FAILED to get configuration" |
| 404 |
> |
heartBeating = False |
| 405 |
> |
Status.Caption = "FAILED to get configuration from the server" |
| 406 |
|
Exit Sub |
| 407 |
|
heartbeatError: |
| 408 |
+ |
heartBeating = False |
| 409 |
|
Status.Caption = "Heatbeat FAILED" |
| 410 |
|
Exit Sub |
| 411 |
|
End Sub |
| 418 |
|
Status.Caption = "" |
| 419 |
|
|
| 420 |
|
If Label3.Caption < 1 Then |
| 421 |
< |
' build the contents of the XML packet. |
| 422 |
< |
xml = "<packet></packet>" |
| 421 |
> |
|
| 422 |
> |
' prepare the contents of the XML packet. |
| 423 |
> |
seqNo = seqNo + 1 |
| 424 |
> |
|
| 425 |
> |
netbiosName = TCPSock.LocalHostName |
| 426 |
> |
|
| 427 |
> |
LocalIP = TCPSock.LocalIP |
| 428 |
> |
packetDate = Date2Num() |
| 429 |
> |
|
| 430 |
> |
|
| 431 |
> |
Dim verinfo As OSVERSIONINFO |
| 432 |
> |
verinfo.dwOSVersionInfoSize = Len(verinfo) |
| 433 |
> |
ret% = GetVersionEx(verinfo) |
| 434 |
> |
If ret% = 0 Then |
| 435 |
> |
MsgBox "Error getting Windows version Information" |
| 436 |
> |
End |
| 437 |
> |
End If |
| 438 |
> |
|
| 439 |
> |
osName = GetVersion() |
| 440 |
> |
osVersionMajor = verinfo.dwMajorVersion |
| 441 |
> |
osVersionMinor = verinfo.dwMinorVersion |
| 442 |
> |
osBuild = verinfo.dwBuildNumber |
| 443 |
> |
|
| 444 |
> |
Dim sysinfo As SYSTEM_INFO |
| 445 |
> |
GetSystemInfo sysinfo |
| 446 |
> |
Select Case sysinfo.dwProcessorType |
| 447 |
> |
Case PROCESSOR_INTEL_386 |
| 448 |
> |
processorType = "Intel 386" |
| 449 |
> |
Case PROCESSOR_INTEL_486 |
| 450 |
> |
processorType = "Intel 486" |
| 451 |
> |
Case PROCESSOR_INTEL_PENTIUM |
| 452 |
> |
processorType = "Intel Pentium variant" |
| 453 |
> |
Case PROCESSOR_MIPS_R4000 |
| 454 |
> |
processorType = "MIPS R4000" |
| 455 |
> |
Case PROCESSOR_ALPHA_21064 |
| 456 |
> |
processorType = "DEC Alpha 21064" |
| 457 |
> |
Case Else |
| 458 |
> |
processorType = "(unknown)" |
| 459 |
> |
End Select |
| 460 |
> |
|
| 461 |
> |
Dim memsts As MEMORYSTATUS |
| 462 |
> |
Dim memory& |
| 463 |
> |
GlobalMemoryStatus memsts |
| 464 |
> |
memory& = memsts.dwTotalPhys |
| 465 |
> |
memTotal = memory& \ 1048576 |
| 466 |
> |
memory& = memsts.dwAvailPhys |
| 467 |
> |
memFree = memory& \ 1048576 |
| 468 |
> |
memory& = memsts.dwTotalVirtual |
| 469 |
> |
swapTotal = memory& \ 1048576 |
| 470 |
> |
memory& = memsts.dwAvailVirtual |
| 471 |
> |
swapFree = memory& \ 1048576 |
| 472 |
> |
|
| 473 |
> |
CUpTime.Capture |
| 474 |
> |
cpu_time = CUpTime.CPUTime |
| 475 |
> |
percent_idle = CUpTime.PercentIdle |
| 476 |
> |
|
| 477 |
> |
'' Doesn't work after 47 days :-/ |
| 478 |
> |
'uptime = GetTickCount \ 1000 |
| 479 |
> |
|
| 480 |
> |
'secondsRunning = secondsRunning + UDPUpdateTime |
| 481 |
> |
'uptime = secondsRunning |
| 482 |
> |
|
| 483 |
> |
uptime = CUpTime.MilliSecs / 1000# |
| 484 |
> |
|
| 485 |
> |
userCount = wksta.LoggedOnUsers |
| 486 |
> |
|
| 487 |
> |
' build the contents of the XML packet |
| 488 |
> |
xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _ |
| 489 |
> |
"<os>" & _ |
| 490 |
> |
"<netbios_name>" & netbiosName & "</netbios_name>" & _ |
| 491 |
> |
"<name>" & osName & "</name>" & _ |
| 492 |
> |
"<version>" & osVersionMajor & "</version>" & _ |
| 493 |
> |
"<release>" & osBuild & "</release>" & _ |
| 494 |
> |
"<platform>" & osName & "</platform>" & _ |
| 495 |
> |
"<minor_version>" & osVersionMinor & "</minor_version>" & _ |
| 496 |
> |
"<processor>" & processorType & "</processor>" & _ |
| 497 |
> |
"<uptime>" & uptime & "</uptime>" & _ |
| 498 |
> |
"</os>" & _ |
| 499 |
> |
"<users><count>" & userCount & "</count></users>" & _ |
| 500 |
> |
"<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _ |
| 501 |
> |
"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _ |
| 502 |
> |
"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _ |
| 503 |
> |
"</packet>" |
| 504 |
> |
Text1.Text = "Last packet contained: -" & vbCrLf & xml |
| 505 |
|
|
| 506 |
|
' Use the first winsock control to send a UDP packet. |
| 507 |
|
UDPSock.RemoteHost = filterHostname |
| 519 |
|
End If |
| 520 |
|
|
| 521 |
|
End Sub |
| 522 |
+ |
|
| 523 |
+ |
Function Date2Num() As Long |
| 524 |
+ |
Dim x As Long |
| 525 |
+ |
x = DateDiff("s", "1-1-1970", Now) |
| 526 |
+ |
Date2Num = x |
| 527 |
+ |
End Function |
