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 = 3 |
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 = 1575 |
39 |
|
Left = 240 |
40 |
|
MultiLine = -1 'True |
41 |
|
ScrollBars = 2 'Vertical |
42 |
< |
TabIndex = 2 |
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 = 1 |
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 = 0 |
55 |
– |
Top = 1560 |
56 |
– |
Width = 975 |
57 |
– |
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 |
+ |
Alignment = 1 'Right Justify |
81 |
+ |
Caption = "Next UDP packet:" |
82 |
+ |
Height = 255 |
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 = 4 |
112 |
< |
Top = 5280 |
113 |
< |
Width = 5415 |
111 |
> |
TabIndex = 2 |
112 |
> |
Top = 1320 |
113 |
> |
Width = 4455 |
114 |
|
End |
115 |
|
End |
116 |
|
Attribute VB_Name = "Form1" |
124 |
|
Dim filterManagerHostname As String |
125 |
|
Dim filterManagerTCPPort As Integer |
126 |
|
|
127 |
+ |
Dim seqNo As Long |
128 |
+ |
Dim machineName As String |
129 |
+ |
|
130 |
|
Dim filterHostname As String |
131 |
|
Dim filterTCPPort As Integer |
132 |
|
Dim filterUDPPort As Integer |
133 |
|
Dim fileList As String |
134 |
|
Dim lastModified As String |
135 |
|
|
136 |
+ |
Dim UDPUpdateTime As Integer |
137 |
+ |
Dim TCPUpdateTime As Integer |
138 |
+ |
|
139 |
|
Dim protocolVersion As String |
140 |
|
Dim connected As Boolean |
141 |
|
Dim responseNumber As Integer |
142 |
|
|
96 |
– |
|
97 |
– |
Private Sub Command1_Click() |
98 |
– |
|
99 |
– |
' build the contents of the XML packet. |
100 |
– |
xml = "<packet></packet>" |
101 |
– |
|
102 |
– |
' Use the first winsock control to send a UDP packet. |
103 |
– |
UDPSock.RemoteHost = filterHostname |
104 |
– |
UDPSock.RemotePort = filterUDPPort |
105 |
– |
UDPSock.SendData xml |
106 |
– |
Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent." |
107 |
– |
|
108 |
– |
End Sub |
109 |
– |
|
110 |
– |
Private Sub Command2_Click() |
111 |
– |
|
112 |
– |
' establish a TCP connection to a filtermanager |
113 |
– |
TCPSock.Close |
114 |
– |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
115 |
– |
|
116 |
– |
End Sub |
117 |
– |
|
118 |
– |
Private Sub Command3_Click() |
119 |
– |
' establish a TCP connection to a filter |
120 |
– |
TCPSock.Close |
121 |
– |
TCPSock.Connect filterHostname, filterTCPPort |
122 |
– |
End Sub |
123 |
– |
|
143 |
|
Private Sub Form_Load() |
144 |
+ |
x = MsgBox(Date2Num()) |
145 |
+ |
|
146 |
|
protocolVersion = "1.1" |
147 |
|
|
148 |
< |
Status.Caption = "i-scream Winhost " & protocolVersion |
148 |
> |
Status.Caption = "Loading" |
149 |
> |
Form1.Caption = "i-scream Winhost " & protocolVersion |
150 |
|
|
151 |
|
''''TEMP |
152 |
|
filterManagerHostname = "killigrew.ukc.ac.uk" |
153 |
|
filterManagerTCPPort = 4567 |
154 |
< |
Exit Sub |
133 |
< |
''' ENDTEMP |
154 |
> |
''''' END TEMP |
155 |
|
|
156 |
+ |
GoTo skip |
157 |
|
On Error GoTo iniError |
158 |
|
Dim buf As String * 256 |
159 |
|
Dim length As Long |
161 |
|
filterManagerHostname = Left$(buf, length) |
162 |
|
length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini") |
163 |
|
filterManagerTCPPort = Left$(buf, length) |
164 |
+ |
skip: |
165 |
+ |
|
166 |
+ |
Status.Caption = "Connecting to Filter Manager" |
167 |
+ |
Reconfigure_Click |
168 |
|
|
143 |
– |
Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager" |
144 |
– |
|
169 |
|
Exit Sub |
170 |
|
|
171 |
|
iniError: |
174 |
|
|
175 |
|
End Sub |
176 |
|
|
177 |
< |
Private Sub Label1_Click() |
177 |
> |
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) |
178 |
> |
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") |
179 |
> |
If x = 7 Then |
180 |
> |
Cancel = True |
181 |
> |
End If |
182 |
> |
SystemTray.Action = 2 |
183 |
|
|
184 |
|
End Sub |
185 |
|
|
186 |
+ |
Private Sub Hide_Click() |
187 |
+ |
Form1.Visible = False |
188 |
+ |
SystemTray.Icon = Val(Form1.Icon) |
189 |
+ |
SystemTray.Action = 0 |
190 |
+ |
End Sub |
191 |
+ |
|
192 |
+ |
Private Sub Reconfigure_Click() |
193 |
+ |
' establish a TCP connection to a filtermanager |
194 |
+ |
connected = False |
195 |
+ |
TCPSock.Close |
196 |
+ |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
197 |
+ |
End Sub |
198 |
+ |
|
199 |
+ |
|
200 |
+ |
|
201 |
+ |
Private Sub SystemTray_MouseDblClk(ByVal Button As Integer) |
202 |
+ |
|
203 |
+ |
Form1.Visible = True |
204 |
+ |
SystemTray.Action = 2 |
205 |
+ |
Form1.SetFocus |
206 |
+ |
|
207 |
+ |
|
208 |
+ |
End Sub |
209 |
+ |
|
210 |
|
Private Sub TCPSock_Connect() |
211 |
|
|
212 |
|
responseNumber = 0 |
251 |
|
TCPSock.SendData "UDPUpdateTime" & vbCrLf |
252 |
|
Case 4: |
253 |
|
If response = "ERROR" Then GoTo configError |
254 |
+ |
UDPUpdateTime = response |
255 |
|
TCPSock.SendData "TCPUpdateTime" & vbCrLf |
256 |
|
Case 5: |
257 |
|
If response = "ERROR" Then GoTo configError |
258 |
+ |
TCPUpdateTime = response |
259 |
|
TCPSock.SendData "ENDCONFIG" & vbCrLf |
260 |
|
Case 6: |
261 |
|
If Not response = "OK" Then GoTo configError |
280 |
|
responseNumber = 0 |
281 |
|
TCPSock.Close |
282 |
|
Text4.Text = Text4.Text & vbCrLf & " <closed>" |
283 |
< |
Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay" |
283 |
> |
Status.Caption = "Configuration successful" |
284 |
> |
Label3.Caption = UDPUpdateTime |
285 |
> |
Label4.Caption = TCPUpdateTime |
286 |
> |
Timer1.Interval = 1000 |
287 |
|
End Select |
288 |
|
Else |
289 |
|
' Perform a heartbeat (1.1) |
304 |
|
Case 5: |
305 |
|
If Not response = "OK" Then GoTo heartbeatError |
306 |
|
TCPSock.Close |
307 |
< |
Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay." |
307 |
> |
Status.Caption = "Heartbeat sent successfully." |
308 |
|
End Select |
309 |
|
|
310 |
|
End If |
313 |
|
Exit Sub |
314 |
|
|
315 |
|
configError: |
316 |
< |
Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration" |
316 |
> |
Status.Caption = "FAILED to get configuration" |
317 |
> |
Exit Sub |
318 |
|
heartbeatError: |
319 |
< |
Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED" |
319 |
> |
Status.Caption = "Heatbeat FAILED" |
320 |
> |
Exit Sub |
321 |
|
End Sub |
322 |
|
|
323 |
+ |
Private Sub Timer1_Timer() |
324 |
+ |
|
325 |
+ |
Label3.Caption = Label3.Caption - 1 |
326 |
+ |
Label4.Caption = Label4.Caption - 1 |
327 |
+ |
|
328 |
+ |
Status.Caption = "" |
329 |
+ |
|
330 |
+ |
If Label3.Caption < 1 Then |
331 |
+ |
' build the contents of the XML packet. |
332 |
+ |
localIP = TCPSock.localIP |
333 |
+ |
machineName = TCPSock.LocalHostName |
334 |
+ |
seqNo = seqNo + 1 |
335 |
+ |
packetDate = Now() |
336 |
+ |
xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _ |
337 |
+ |
"" & _ |
338 |
+ |
"" & _ |
339 |
+ |
"" & _ |
340 |
+ |
"" & _ |
341 |
+ |
"" & _ |
342 |
+ |
"" & _ |
343 |
+ |
"" & _ |
344 |
+ |
"" & _ |
345 |
+ |
"" & _ |
346 |
+ |
"" & _ |
347 |
+ |
"" & _ |
348 |
+ |
"" & _ |
349 |
+ |
"" & _ |
350 |
+ |
"" & _ |
351 |
+ |
"" |
352 |
+ |
Text4.Text = Text4.Text + xml |
353 |
+ |
|
354 |
+ |
' Use the first winsock control to send a UDP packet. |
355 |
+ |
UDPSock.RemoteHost = filterHostname |
356 |
+ |
UDPSock.RemotePort = filterUDPPort |
357 |
+ |
UDPSock.SendData xml |
358 |
+ |
Status.Caption = "UDP packet sent" |
359 |
+ |
Label3.Caption = UDPUpdateTime |
360 |
+ |
End If |
361 |
+ |
|
362 |
+ |
If Label4.Caption < 1 Then |
363 |
+ |
' establish a TCP connection to a filter |
364 |
+ |
TCPSock.Close |
365 |
+ |
TCPSock.Connect filterHostname, filterTCPPort |
366 |
+ |
Label4.Caption = TCPUpdateTime |
367 |
+ |
End If |
368 |
+ |
|
369 |
+ |
End Sub |
370 |
+ |
|
371 |
+ |
Function Date2Num() As Long |
372 |
+ |
Date2Num = DateDiff("s", "1-1-1970", Now) |
373 |
+ |
End Function |