ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/winhost/nettest.frm
(Generate patch)

Comparing projects/cms/source/host/winhost/nettest.frm (file contents):
Revision 1.6 by pjm2, Fri Feb 23 10:53:30 2001 UTC vs.
Revision 1.14 by pjm2, Fri Feb 23 13:27:09 2001 UTC

# Line 1 | Line 1
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"
# Line 83 | Line 124 | Private Declare Function GetPrivateProfileInt Lib "ker
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 +    
145      protocolVersion = "1.1"
146      
147 <    Status.Caption = "i-scream Winhost " & protocolVersion
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
133 <    ''' ENDTEMP
153 >    ''''' END TEMP
154      
155 +    GoTo skip
156      On Error GoTo iniError
157      Dim buf As String * 256
158      Dim length As Long
# Line 139 | Line 160 | Private Sub Form_Load()
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      
143    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
144    
168      Exit Sub
169      
170   iniError:
# Line 150 | Line 173 | iniError:
173      
174   End Sub
175  
176 < Private Sub Label1_Click()
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
# Line 198 | Line 250 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
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
# Line 225 | Line 279 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
279                  responseNumber = 0
280                  TCPSock.Close
281                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
282 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - 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)
# Line 246 | Line 303 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
303              Case 5:
304                  If Not response = "OK" Then GoTo heartbeatError
305                  TCPSock.Close
306 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
306 >                Status.Caption = "Heartbeat sent successfully."
307          End Select
308      
309      End If
# Line 255 | Line 312 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
312      Exit Sub
313      
314   configError:
315 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration"
315 >    Status.Caption = "FAILED to get configuration"
316 >    Exit Sub
317   heartbeatError:
318 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED"
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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines