| 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" |
| 5 |
> |
BorderStyle = 4 'Fixed ToolWindow |
| 6 |
> |
Caption = "i-scream Winhost" |
| 7 |
|
ClientHeight = 5655 |
| 8 |
|
ClientLeft = 45 |
| 9 |
< |
ClientTop = 330 |
| 10 |
< |
ClientWidth = 5670 |
| 9 |
> |
ClientTop = 285 |
| 10 |
> |
ClientWidth = 4710 |
| 11 |
|
LinkTopic = "Form1" |
| 12 |
|
MaxButton = 0 'False |
| 12 |
– |
MinButton = 0 'False |
| 13 |
|
ScaleHeight = 5655 |
| 14 |
< |
ScaleWidth = 5670 |
| 14 |
> |
ScaleWidth = 4710 |
| 15 |
|
ShowInTaskbar = 0 'False |
| 16 |
|
StartUpPosition = 3 'Windows Default |
| 17 |
< |
Begin VB.CommandButton Command3 |
| 18 |
< |
Caption = "TCP to Filter" |
| 17 |
> |
Begin VB.CommandButton Hide |
| 18 |
> |
Caption = "Hide Window" |
| 19 |
|
Height = 375 |
| 20 |
< |
Left = 3720 |
| 21 |
< |
TabIndex = 5 |
| 22 |
< |
Top = 2520 |
| 23 |
< |
Width = 1575 |
| 20 |
> |
Left = 3120 |
| 21 |
> |
TabIndex = 7 |
| 22 |
> |
Top = 840 |
| 23 |
> |
Width = 1455 |
| 24 |
|
End |
| 25 |
+ |
Begin SysTray.SystemTray SystemTray |
| 26 |
+ |
Left = 2160 |
| 27 |
+ |
Top = 1800 |
| 28 |
+ |
_ExtentX = 847 |
| 29 |
+ |
_ExtentY = 847 |
| 30 |
+ |
SysTrayText = "i-scream Winhost" |
| 31 |
+ |
IconFile = 0 |
| 32 |
+ |
End |
| 33 |
+ |
Begin VB.Timer Timer1 |
| 34 |
+ |
Left = 2760 |
| 35 |
+ |
Top = 1800 |
| 36 |
+ |
End |
| 37 |
|
Begin VB.TextBox Text4 |
| 38 |
< |
Height = 2535 |
| 38 |
> |
Height = 1575 |
| 39 |
|
Left = 240 |
| 40 |
|
MultiLine = -1 'True |
| 41 |
|
ScrollBars = 2 'Vertical |
| 42 |
< |
TabIndex = 4 |
| 42 |
> |
TabIndex = 1 |
| 43 |
|
Text = "nettest.frx":0000 |
| 44 |
|
Top = 3000 |
| 45 |
< |
Width = 5055 |
| 45 |
> |
Width = 3975 |
| 46 |
|
End |
| 47 |
< |
Begin VB.CommandButton Command2 |
| 48 |
< |
Caption = "TCP to FilterManager" |
| 47 |
> |
Begin VB.CommandButton Reconfigure |
| 48 |
> |
Caption = "Reconfigure with FilterManager" |
| 49 |
|
Height = 375 |
| 50 |
< |
Left = 3360 |
| 51 |
< |
TabIndex = 3 |
| 52 |
< |
Top = 2040 |
| 53 |
< |
Width = 1935 |
| 50 |
> |
Left = 120 |
| 51 |
> |
TabIndex = 0 |
| 52 |
> |
Top = 840 |
| 53 |
> |
Width = 2895 |
| 54 |
|
End |
| 55 |
|
Begin MSWinsockLib.Winsock TCPSock |
| 56 |
< |
Left = 4920 |
| 57 |
< |
Top = 120 |
| 56 |
> |
Left = 3720 |
| 57 |
> |
Top = 1800 |
| 58 |
|
_ExtentX = 741 |
| 59 |
|
_ExtentY = 741 |
| 60 |
|
_Version = 393216 |
| 61 |
|
End |
| 50 |
– |
Begin VB.CommandButton Command1 |
| 51 |
– |
Caption = "Send UDP" |
| 52 |
– |
Height = 375 |
| 53 |
– |
Left = 4320 |
| 54 |
– |
TabIndex = 2 |
| 55 |
– |
Top = 1560 |
| 56 |
– |
Width = 975 |
| 57 |
– |
End |
| 58 |
– |
Begin VB.TextBox Text1 |
| 59 |
– |
Height = 855 |
| 60 |
– |
Left = 360 |
| 61 |
– |
TabIndex = 0 |
| 62 |
– |
Text = "<packet></packet>" |
| 63 |
– |
Top = 600 |
| 64 |
– |
Width = 4935 |
| 65 |
– |
End |
| 62 |
|
Begin MSWinsockLib.Winsock UDPSock |
| 63 |
< |
Left = 4320 |
| 64 |
< |
Top = 120 |
| 63 |
> |
Left = 3240 |
| 64 |
> |
Top = 1800 |
| 65 |
|
_ExtentX = 741 |
| 66 |
|
_ExtentY = 741 |
| 67 |
|
_Version = 393216 |
| 68 |
|
Protocol = 1 |
| 69 |
|
End |
| 70 |
+ |
Begin VB.Label Label2 |
| 71 |
+ |
Alignment = 1 'Right Justify |
| 72 |
+ |
Caption = "Next heartbeat:" |
| 73 |
+ |
Height = 255 |
| 74 |
+ |
Left = 2400 |
| 75 |
+ |
TabIndex = 6 |
| 76 |
+ |
Top = 480 |
| 77 |
+ |
Width = 1455 |
| 78 |
+ |
End |
| 79 |
|
Begin VB.Label Label1 |
| 80 |
< |
Caption = "Packet contents" |
| 80 |
> |
Alignment = 1 'Right Justify |
| 81 |
> |
Caption = "Next UDP packet:" |
| 82 |
|
Height = 255 |
| 83 |
< |
Left = 360 |
| 84 |
< |
TabIndex = 1 |
| 85 |
< |
Top = 360 |
| 86 |
< |
Width = 2895 |
| 83 |
> |
Left = 2400 |
| 84 |
> |
TabIndex = 5 |
| 85 |
> |
Top = 120 |
| 86 |
> |
Width = 1455 |
| 87 |
|
End |
| 88 |
+ |
Begin VB.Label Label4 |
| 89 |
+ |
BorderStyle = 1 'Fixed Single |
| 90 |
+ |
Caption = "0" |
| 91 |
+ |
Height = 255 |
| 92 |
+ |
Left = 3960 |
| 93 |
+ |
TabIndex = 4 |
| 94 |
+ |
Top = 480 |
| 95 |
+ |
Width = 615 |
| 96 |
+ |
End |
| 97 |
+ |
Begin VB.Label Label3 |
| 98 |
+ |
BorderStyle = 1 'Fixed Single |
| 99 |
+ |
Caption = "0" |
| 100 |
+ |
Height = 255 |
| 101 |
+ |
Left = 3960 |
| 102 |
+ |
TabIndex = 3 |
| 103 |
+ |
Top = 120 |
| 104 |
+ |
Width = 615 |
| 105 |
+ |
End |
| 106 |
+ |
Begin VB.Label Status |
| 107 |
+ |
Alignment = 2 'Center |
| 108 |
+ |
Caption = "Status:" |
| 109 |
+ |
Height = 255 |
| 110 |
+ |
Left = 120 |
| 111 |
+ |
TabIndex = 2 |
| 112 |
+ |
Top = 1320 |
| 113 |
+ |
Width = 4455 |
| 114 |
+ |
End |
| 115 |
|
End |
| 116 |
|
Attribute VB_Name = "Form1" |
| 117 |
|
Attribute VB_GlobalNameSpace = False |
| 118 |
|
Attribute VB_Creatable = False |
| 119 |
|
Attribute VB_PredeclaredId = True |
| 120 |
|
Attribute VB_Exposed = False |
| 121 |
+ |
' For the system tray bits |
| 122 |
|
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 |
| 123 |
|
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 |
| 124 |
|
|
| 125 |
|
Dim filterManagerHostname As String |
| 126 |
|
Dim filterManagerTCPPort As Integer |
| 127 |
|
|
| 128 |
+ |
Dim seqNo As Long |
| 129 |
+ |
Dim machineName As String |
| 130 |
+ |
|
| 131 |
|
Dim filterHostname As String |
| 132 |
|
Dim filterTCPPort As Integer |
| 133 |
|
Dim filterUDPPort As Integer |
| 134 |
|
Dim fileList As String |
| 135 |
|
Dim lastModified As String |
| 136 |
|
|
| 137 |
+ |
Dim UDPUpdateTime As Integer |
| 138 |
+ |
Dim TCPUpdateTime As Integer |
| 139 |
+ |
|
| 140 |
|
Dim protocolVersion As String |
| 141 |
|
Dim connected As Boolean |
| 102 |
– |
Dim responseNumber As Integer |
| 142 |
|
|
| 143 |
+ |
'Dim CUpTime As New CUpTime |
| 144 |
|
|
| 145 |
< |
Private Sub Command1_Click() |
| 145 |
> |
Dim responseNumber As Integer |
| 146 |
|
|
| 107 |
– |
' build the contents of the XML packet. |
| 108 |
– |
xml = "<packet></packet>" |
| 109 |
– |
|
| 110 |
– |
' Use the first winsock control to send a UDP packet. |
| 111 |
– |
UDPSock.RemoteHost = filterHostname |
| 112 |
– |
UDPSock.RemotePort = filterUDPPort |
| 113 |
– |
UDPSock.SendData xml |
| 114 |
– |
|
| 115 |
– |
End Sub |
| 116 |
– |
|
| 117 |
– |
Private Sub Command2_Click() |
| 118 |
– |
|
| 119 |
– |
' establish a TCP connection to a filtermanager |
| 120 |
– |
TCPSock.Close |
| 121 |
– |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
| 122 |
– |
|
| 123 |
– |
End Sub |
| 124 |
– |
|
| 125 |
– |
Private Sub Command3_Click() |
| 126 |
– |
' establish a TCP connection to a filter |
| 127 |
– |
TCPSock.Close |
| 128 |
– |
TCPSock.Connect filterHostname, filterTCPPort |
| 129 |
– |
End Sub |
| 130 |
– |
|
| 147 |
|
Private Sub Form_Load() |
| 148 |
+ |
|
| 149 |
|
protocolVersion = "1.1" |
| 150 |
|
|
| 151 |
+ |
Status.Caption = "Loading" |
| 152 |
+ |
'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion() |
| 153 |
+ |
|
| 154 |
|
''''TEMP |
| 155 |
|
filterManagerHostname = "killigrew.ukc.ac.uk" |
| 156 |
|
filterManagerTCPPort = 4567 |
| 157 |
< |
Exit Sub |
| 138 |
< |
''' ENDTEMP |
| 157 |
> |
''''' END TEMP |
| 158 |
|
|
| 159 |
+ |
GoTo skip |
| 160 |
|
On Error GoTo iniError |
| 161 |
|
Dim buf As String * 256 |
| 162 |
|
Dim length As Long |
| 164 |
|
filterManagerHostname = Left$(buf, length) |
| 165 |
|
length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini") |
| 166 |
|
filterManagerTCPPort = Left$(buf, length) |
| 167 |
+ |
skip: |
| 168 |
+ |
|
| 169 |
+ |
Status.Caption = "Connecting to Filter Manager" |
| 170 |
+ |
Reconfigure_Click |
| 171 |
|
|
| 172 |
+ |
Form1.Show |
| 173 |
+ |
SystemTray.Action = 0 |
| 174 |
+ |
|
| 175 |
+ |
|
| 176 |
|
Exit Sub |
| 177 |
|
|
| 178 |
|
iniError: |
| 181 |
|
|
| 182 |
|
End Sub |
| 183 |
|
|
| 184 |
+ |
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) |
| 185 |
+ |
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") |
| 186 |
+ |
If x = 7 Then |
| 187 |
+ |
Cancel = True |
| 188 |
+ |
Else |
| 189 |
+ |
SystemTray.Action = 2 |
| 190 |
+ |
End If |
| 191 |
+ |
|
| 192 |
+ |
End Sub |
| 193 |
+ |
|
| 194 |
+ |
Private Sub Hide_Click() |
| 195 |
+ |
Form1.Visible = False |
| 196 |
+ |
SystemTray.Icon = Val(Form1.Icon) |
| 197 |
+ |
End Sub |
| 198 |
+ |
|
| 199 |
+ |
Private Sub Reconfigure_Click() |
| 200 |
+ |
' establish a TCP connection to a filtermanager |
| 201 |
+ |
connected = False |
| 202 |
+ |
TCPSock.Close |
| 203 |
+ |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
| 204 |
+ |
End Sub |
| 205 |
+ |
|
| 206 |
+ |
|
| 207 |
+ |
|
| 208 |
+ |
Private Sub SystemTray_MouseDblClk(ByVal Button As Integer) |
| 209 |
+ |
|
| 210 |
+ |
Form1.Visible = True |
| 211 |
+ |
Form1.SetFocus |
| 212 |
+ |
|
| 213 |
+ |
|
| 214 |
+ |
End Sub |
| 215 |
+ |
|
| 216 |
|
Private Sub TCPSock_Connect() |
| 217 |
< |
|
| 218 |
< |
responseNumber = 0 |
| 217 |
> |
|
| 218 |
> |
responseNumber = 0 |
| 219 |
|
|
| 220 |
|
' Send something as soon as we connect to the server. |
| 221 |
|
If connected = False Then |
| 257 |
|
TCPSock.SendData "UDPUpdateTime" & vbCrLf |
| 258 |
|
Case 4: |
| 259 |
|
If response = "ERROR" Then GoTo configError |
| 260 |
+ |
UDPUpdateTime = response |
| 261 |
|
TCPSock.SendData "TCPUpdateTime" & vbCrLf |
| 262 |
|
Case 5: |
| 263 |
|
If response = "ERROR" Then GoTo configError |
| 264 |
+ |
TCPUpdateTime = response |
| 265 |
|
TCPSock.SendData "ENDCONFIG" & vbCrLf |
| 266 |
|
Case 6: |
| 267 |
|
If Not response = "OK" Then GoTo configError |
| 286 |
|
responseNumber = 0 |
| 287 |
|
TCPSock.Close |
| 288 |
|
Text4.Text = Text4.Text & vbCrLf & " <closed>" |
| 289 |
< |
x = MsgBox("got config okay") |
| 289 |
> |
Status.Caption = "Configuration successful" |
| 290 |
> |
Label3.Caption = UDPUpdateTime |
| 291 |
> |
Label4.Caption = TCPUpdateTime |
| 292 |
> |
Timer1.Interval = 1000 |
| 293 |
|
End Select |
| 294 |
|
Else |
| 295 |
|
' Perform a heartbeat (1.1) |
| 310 |
|
Case 5: |
| 311 |
|
If Not response = "OK" Then GoTo heartbeatError |
| 312 |
|
TCPSock.Close |
| 313 |
< |
x = MsgBox("heartbeat sent okay.") |
| 313 |
> |
Status.Caption = "Heartbeat sent successfully." |
| 314 |
|
End Select |
| 315 |
|
|
| 316 |
|
End If |
| 319 |
|
Exit Sub |
| 320 |
|
|
| 321 |
|
configError: |
| 322 |
< |
x = MsgBox("error doing configuration") |
| 322 |
> |
Status.Caption = "FAILED to get configuration" |
| 323 |
> |
Exit Sub |
| 324 |
|
heartbeatError: |
| 325 |
< |
x = MsgBox("error doing configuration") |
| 325 |
> |
Status.Caption = "Heatbeat FAILED" |
| 326 |
> |
Exit Sub |
| 327 |
|
End Sub |
| 328 |
|
|
| 329 |
+ |
Private Sub Timer1_Timer() |
| 330 |
+ |
|
| 331 |
+ |
Label3.Caption = Label3.Caption - 1 |
| 332 |
+ |
Label4.Caption = Label4.Caption - 1 |
| 333 |
+ |
|
| 334 |
+ |
Status.Caption = "" |
| 335 |
+ |
|
| 336 |
+ |
If Label3.Caption < 1 Then |
| 337 |
+ |
|
| 338 |
+ |
' prepare the contents of the XML packet. |
| 339 |
+ |
seqNo = seqNo + 1 |
| 340 |
+ |
machineName = TCPSock.LocalHostName |
| 341 |
+ |
LocalIP = TCPSock.LocalIP |
| 342 |
+ |
packetDate = Date2Num() |
| 343 |
+ |
|
| 344 |
+ |
|
| 345 |
+ |
Dim verinfo As OSVERSIONINFO |
| 346 |
+ |
verinfo.dwOSVersionInfoSize = Len(verinfo) |
| 347 |
+ |
ret% = GetVersionEx(verinfo) |
| 348 |
+ |
If ret% = 0 Then |
| 349 |
+ |
MsgBox "Error getting Windows version Information" |
| 350 |
+ |
End |
| 351 |
+ |
End If |
| 352 |
+ |
|
| 353 |
+ |
osName = getVersion() |
| 354 |
+ |
osVersionMajor = verinfo.dwMajorVersion |
| 355 |
+ |
osVersionMinor = verinfo.dwMinorVersion |
| 356 |
+ |
osBuild = verinfo.dwBuildNumber |
| 357 |
+ |
|
| 358 |
+ |
Dim sysinfo As SYSTEM_INFO |
| 359 |
+ |
GetSystemInfo sysinfo |
| 360 |
+ |
Select Case sysinfo.dwProcessorType |
| 361 |
+ |
Case PROCESSOR_INTEL_386 |
| 362 |
+ |
processorType = "Intel 386" |
| 363 |
+ |
Case PROCESSOR_INTEL_486 |
| 364 |
+ |
processorType = "Intel 486" |
| 365 |
+ |
Case PROCESSOR_INTEL_PENTIUM |
| 366 |
+ |
processorType = "Intel Pentium variant" |
| 367 |
+ |
Case PROCESSOR_MIPS_R4000 |
| 368 |
+ |
processorType = "MIPS R4000" |
| 369 |
+ |
Case PROCESSOR_ALPHA_21064 |
| 370 |
+ |
processorType = "DEC Alpha 21064" |
| 371 |
+ |
Case Else |
| 372 |
+ |
processorType = "(unknown)" |
| 373 |
+ |
End Select |
| 374 |
+ |
|
| 375 |
+ |
Dim memsts As MEMORYSTATUS |
| 376 |
+ |
Dim memory& |
| 377 |
+ |
GlobalMemoryStatus memsts |
| 378 |
+ |
memory& = memsts.dwTotalPhys |
| 379 |
+ |
memTotal = memory& \ 1024 |
| 380 |
+ |
memory& = memsts.dwAvailPhys |
| 381 |
+ |
memFree = memory& \ 1024 |
| 382 |
+ |
memory& = memsts.dwTotalVirtual |
| 383 |
+ |
swapTotal = memory& \ 1024 |
| 384 |
+ |
memory& = memsts.dwAvailVirtual |
| 385 |
+ |
swapFree = memory& \ 1024 |
| 386 |
+ |
|
| 387 |
+ |
' build the contents of the XML packet |
| 388 |
+ |
xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _ |
| 389 |
+ |
"<os>" & _ |
| 390 |
+ |
"<name>" & osName & "</name>" & _ |
| 391 |
+ |
"<version>" & osVersionMajor & "</version>" & _ |
| 392 |
+ |
"<release>" & osBuild & "</release>" & _ |
| 393 |
+ |
"<platform>" & osName & "</platform>" & _ |
| 394 |
+ |
"<minor_version>" & osVersionMinor & "</minor_version>" & _ |
| 395 |
+ |
"<processor>" & processorType & "</processor>" & _ |
| 396 |
+ |
"</os>" & _ |
| 397 |
+ |
"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _ |
| 398 |
+ |
"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _ |
| 399 |
+ |
"" |
| 400 |
+ |
Text4.Text = Text4.Text + xml |
| 401 |
+ |
|
| 402 |
+ |
' Use the first winsock control to send a UDP packet. |
| 403 |
+ |
UDPSock.RemoteHost = filterHostname |
| 404 |
+ |
UDPSock.RemotePort = filterUDPPort |
| 405 |
+ |
UDPSock.SendData xml |
| 406 |
+ |
Status.Caption = "UDP packet sent" |
| 407 |
+ |
Label3.Caption = UDPUpdateTime |
| 408 |
+ |
End If |
| 409 |
+ |
|
| 410 |
+ |
If Label4.Caption < 1 Then |
| 411 |
+ |
' establish a TCP connection to a filter |
| 412 |
+ |
TCPSock.Close |
| 413 |
+ |
TCPSock.Connect filterHostname, filterTCPPort |
| 414 |
+ |
Label4.Caption = TCPUpdateTime |
| 415 |
+ |
End If |
| 416 |
+ |
|
| 417 |
+ |
End Sub |
| 418 |
+ |
|
| 419 |
+ |
Function Date2Num() As Long |
| 420 |
+ |
Dim x As Long |
| 421 |
+ |
x = DateDiff("s", "1-1-1970", Now) |
| 422 |
+ |
Date2Num = x |
| 423 |
+ |
End Function |
