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 |
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 |
|
|
104 |
– |
|
105 |
– |
Private Sub Command1_Click() |
106 |
– |
|
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 |
– |
|
143 |
|
Private Sub Form_Load() |
144 |
+ |
|
145 |
|
protocolVersion = "1.1" |
146 |
|
|
147 |
+ |
Status.Caption = "Loading" |
148 |
+ |
Form1.Caption = "i-scream Winhost " & protocolVersion |
149 |
+ |
|
150 |
|
''''TEMP |
151 |
|
filterManagerHostname = "killigrew.ukc.ac.uk" |
152 |
|
filterManagerTCPPort = 4567 |
153 |
< |
Exit Sub |
138 |
< |
''' ENDTEMP |
153 |
> |
''''' END TEMP |
154 |
|
|
155 |
+ |
GoTo skip |
156 |
|
On Error GoTo iniError |
157 |
|
Dim buf As String * 256 |
158 |
|
Dim length As Long |
160 |
|
filterManagerHostname = Left$(buf, length) |
161 |
|
length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini") |
162 |
|
filterManagerTCPPort = Left$(buf, length) |
163 |
+ |
skip: |
164 |
+ |
|
165 |
+ |
Status.Caption = "Connecting to Filter Manager" |
166 |
+ |
Reconfigure_Click |
167 |
|
|
168 |
|
Exit Sub |
169 |
|
|
173 |
|
|
174 |
|
End Sub |
175 |
|
|
176 |
+ |
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) |
177 |
+ |
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") |
178 |
+ |
If x = 7 Then |
179 |
+ |
Cancel = True |
180 |
+ |
End If |
181 |
+ |
SystemTray.Action = 2 |
182 |
+ |
|
183 |
+ |
End Sub |
184 |
+ |
|
185 |
+ |
Private Sub Hide_Click() |
186 |
+ |
Form1.Visible = False |
187 |
+ |
SystemTray.Icon = Val(Form1.Icon) |
188 |
+ |
SystemTray.Action = 0 |
189 |
+ |
End Sub |
190 |
+ |
|
191 |
+ |
Private Sub Reconfigure_Click() |
192 |
+ |
' establish a TCP connection to a filtermanager |
193 |
+ |
connected = False |
194 |
+ |
TCPSock.Close |
195 |
+ |
TCPSock.Connect filterManagerHostname, filterManagerTCPPort |
196 |
+ |
End Sub |
197 |
+ |
|
198 |
+ |
|
199 |
+ |
|
200 |
+ |
Private Sub SystemTray_MouseDblClk(ByVal Button As Integer) |
201 |
+ |
|
202 |
+ |
Form1.Visible = True |
203 |
+ |
SystemTray.Action = 2 |
204 |
+ |
Form1.SetFocus |
205 |
+ |
|
206 |
+ |
|
207 |
+ |
End Sub |
208 |
+ |
|
209 |
|
Private Sub TCPSock_Connect() |
210 |
< |
|
211 |
< |
responseNumber = 0 |
210 |
> |
|
211 |
> |
responseNumber = 0 |
212 |
|
|
213 |
|
' Send something as soon as we connect to the server. |
214 |
|
If connected = False Then |
250 |
|
TCPSock.SendData "UDPUpdateTime" & vbCrLf |
251 |
|
Case 4: |
252 |
|
If response = "ERROR" Then GoTo configError |
253 |
+ |
UDPUpdateTime = response |
254 |
|
TCPSock.SendData "TCPUpdateTime" & vbCrLf |
255 |
|
Case 5: |
256 |
|
If response = "ERROR" Then GoTo configError |
257 |
+ |
TCPUpdateTime = response |
258 |
|
TCPSock.SendData "ENDCONFIG" & vbCrLf |
259 |
|
Case 6: |
260 |
|
If Not response = "OK" Then GoTo configError |
279 |
|
responseNumber = 0 |
280 |
|
TCPSock.Close |
281 |
|
Text4.Text = Text4.Text & vbCrLf & " <closed>" |
282 |
< |
x = MsgBox("got config okay") |
282 |
> |
Status.Caption = "Configuration successful" |
283 |
> |
Label3.Caption = UDPUpdateTime |
284 |
> |
Label4.Caption = TCPUpdateTime |
285 |
> |
Timer1.Interval = 1000 |
286 |
|
End Select |
287 |
|
Else |
288 |
|
' Perform a heartbeat (1.1) |
303 |
|
Case 5: |
304 |
|
If Not response = "OK" Then GoTo heartbeatError |
305 |
|
TCPSock.Close |
306 |
< |
x = MsgBox("heartbeat sent okay.") |
306 |
> |
Status.Caption = "Heartbeat sent successfully." |
307 |
|
End Select |
308 |
|
|
309 |
|
End If |
312 |
|
Exit Sub |
313 |
|
|
314 |
|
configError: |
315 |
< |
x = MsgBox("error doing configuration") |
315 |
> |
Status.Caption = "FAILED to get configuration" |
316 |
> |
Exit Sub |
317 |
|
heartbeatError: |
318 |
< |
x = MsgBox("error doing configuration") |
318 |
> |
Status.Caption = "Heatbeat FAILED" |
319 |
> |
Exit Sub |
320 |
|
End Sub |
321 |
|
|
322 |
+ |
Private Sub Timer1_Timer() |
323 |
+ |
|
324 |
+ |
Label3.Caption = Label3.Caption - 1 |
325 |
+ |
Label4.Caption = Label4.Caption - 1 |
326 |
+ |
|
327 |
+ |
Status.Caption = "" |
328 |
+ |
|
329 |
+ |
If Label3.Caption < 1 Then |
330 |
+ |
' build the contents of the XML packet. |
331 |
+ |
localIP = TCPSock.localIP |
332 |
+ |
machineName = TCPSock.LocalHostName |
333 |
+ |
seqNo = seqNo + 1 |
334 |
+ |
packetDate = Date2Num() |
335 |
+ |
xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _ |
336 |
+ |
"" & _ |
337 |
+ |
"" & _ |
338 |
+ |
"" & _ |
339 |
+ |
"" & _ |
340 |
+ |
"" & _ |
341 |
+ |
"" & _ |
342 |
+ |
"" & _ |
343 |
+ |
"" & _ |
344 |
+ |
"" & _ |
345 |
+ |
"" & _ |
346 |
+ |
"" & _ |
347 |
+ |
"" & _ |
348 |
+ |
"" & _ |
349 |
+ |
"" & _ |
350 |
+ |
"" |
351 |
+ |
Text4.Text = Text4.Text + xml |
352 |
+ |
|
353 |
+ |
' Use the first winsock control to send a UDP packet. |
354 |
+ |
UDPSock.RemoteHost = filterHostname |
355 |
+ |
UDPSock.RemotePort = filterUDPPort |
356 |
+ |
UDPSock.SendData xml |
357 |
+ |
Status.Caption = "UDP packet sent" |
358 |
+ |
Label3.Caption = UDPUpdateTime |
359 |
+ |
End If |
360 |
+ |
|
361 |
+ |
If Label4.Caption < 1 Then |
362 |
+ |
' establish a TCP connection to a filter |
363 |
+ |
TCPSock.Close |
364 |
+ |
TCPSock.Connect filterHostname, filterTCPPort |
365 |
+ |
Label4.Caption = TCPUpdateTime |
366 |
+ |
End If |
367 |
+ |
|
368 |
+ |
End Sub |
369 |
+ |
|
370 |
+ |
Function Date2Num() As Long |
371 |
+ |
Dim x As Long |
372 |
+ |
x = DateDiff("s", "1-1-1970", Now) |
373 |
+ |
Date2Num = x |
374 |
+ |
End Function |