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.3 by pjm2, Fri Feb 23 10:07:55 2001 UTC vs.
Revision 1.8 by pjm2, Fri Feb 23 11:25:35 2001 UTC

# Line 14 | Line 14 | Begin VB.Form Form1
14     ScaleWidth      =   5670
15     ShowInTaskbar   =   0   'False
16     StartUpPosition =   3  'Windows Default
17 +   Begin VB.Timer Timer1
18 +      Left            =   3840
19 +      Top             =   120
20 +   End
21     Begin VB.CommandButton Command3
22        Caption         =   "TCP to Filter"
23        Height          =   375
24        Left            =   3720
25 <      TabIndex        =   9
25 >      TabIndex        =   3
26        Top             =   2520
27        Width           =   1575
28     End
29     Begin VB.TextBox Text4
30 <      Height          =   2535
30 >      Height          =   1575
31        Left            =   240
32        MultiLine       =   -1  'True
33        ScrollBars      =   2  'Vertical
34 <      TabIndex        =   8
34 >      TabIndex        =   2
35        Text            =   "nettest.frx":0000
36        Top             =   3000
37        Width           =   5055
# Line 36 | Line 40 | Begin VB.Form Form1
40        Caption         =   "TCP to FilterManager"
41        Height          =   375
42        Left            =   3360
43 <      TabIndex        =   7
43 >      TabIndex        =   1
44        Top             =   2040
45        Width           =   1935
46     End
47 <   Begin MSWinsockLib.Winsock Winsock2
47 >   Begin MSWinsockLib.Winsock TCPSock
48        Left            =   4920
49        Top             =   120
50        _ExtentX        =   741
51        _ExtentY        =   741
52        _Version        =   393216
53     End
50 –   Begin VB.TextBox Text3
51 –      Height          =   285
52 –      Left            =   1680
53 –      TabIndex        =   5
54 –      Text            =   "killigrew.ukc.ac.uk"
55 –      Top             =   1560
56 –      Width           =   2535
57 –   End
58 –   Begin VB.TextBox Text2
59 –      Height          =   285
60 –      Left            =   1680
61 –      TabIndex        =   3
62 –      Text            =   "4567"
63 –      Top             =   1920
64 –      Width           =   855
65 –   End
54     Begin VB.CommandButton Command1
55        Caption         =   "Send UDP"
56        Height          =   375
57        Left            =   4320
58 <      TabIndex        =   2
58 >      TabIndex        =   0
59        Top             =   1560
60        Width           =   975
61     End
62 <   Begin VB.TextBox Text1
75 <      Height          =   855
76 <      Left            =   360
77 <      TabIndex        =   0
78 <      Text            =   "<packet></packet>"
79 <      Top             =   600
80 <      Width           =   4935
81 <   End
82 <   Begin MSWinsockLib.Winsock Winsock1
62 >   Begin MSWinsockLib.Winsock UDPSock
63        Left            =   4320
64        Top             =   120
65        _ExtentX        =   741
# Line 87 | Line 67 | Begin VB.Form Form1
67        _Version        =   393216
68        Protocol        =   1
69     End
70 +   Begin VB.Label Label4
71 +      Caption         =   "Label4"
72 +      Height          =   255
73 +      Left            =   1920
74 +      TabIndex        =   8
75 +      Top             =   1320
76 +      Width           =   615
77 +   End
78     Begin VB.Label Label3
79 <      Alignment       =   1  'Right Justify
92 <      Caption         =   "Destination:"
79 >      Caption         =   "Label3"
80        Height          =   255
81 <      Left            =   360
82 <      TabIndex        =   6
83 <      Top             =   1560
84 <      Width           =   1215
81 >      Left            =   1920
82 >      TabIndex        =   7
83 >      Top             =   960
84 >      Width           =   615
85     End
86     Begin VB.Label Label2
87 <      Alignment       =   1  'Right Justify
101 <      Caption         =   "Port:"
87 >      Caption         =   "Label2"
88        Height          =   255
89 <      Left            =   360
90 <      TabIndex        =   4
91 <      Top             =   1920
92 <      Width           =   1215
89 >      Left            =   120
90 >      TabIndex        =   6
91 >      Top             =   600
92 >      Width           =   3375
93     End
94     Begin VB.Label Label1
95 <      Caption         =   "Packet contents"
95 >      Caption         =   "Label1"
96        Height          =   255
97 <      Left            =   360
98 <      TabIndex        =   1
99 <      Top             =   360
100 <      Width           =   2895
97 >      Left            =   120
98 >      TabIndex        =   5
99 >      Top             =   240
100 >      Width           =   3375
101     End
102 +   Begin VB.Label Status
103 +      Caption         =   "Status:"
104 +      Height          =   255
105 +      Left            =   120
106 +      TabIndex        =   4
107 +      Top             =   5280
108 +      Width           =   5415
109 +   End
110   End
111   Attribute VB_Name = "Form1"
112   Attribute VB_GlobalNameSpace = False
113   Attribute VB_Creatable = False
114   Attribute VB_PredeclaredId = True
115   Attribute VB_Exposed = False
116 + 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
117 + 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
118 +
119 + Dim filterManagerHostname As String
120 + Dim filterManagerTCPPort As Integer
121 +
122   Dim filterHostname As String
123   Dim filterTCPPort As Integer
124   Dim filterUDPPort As Integer
125   Dim fileList As String
126   Dim lastModified As String
127  
128 + Dim UDPUpdateTime As Integer
129 + Dim TCPUpdateTime As Integer
130 +
131   Dim protocolVersion As String
132   Dim connected As Boolean
133   Dim responseNumber As Integer
# Line 132 | Line 135 | Dim responseNumber As Integer
135  
136   Private Sub Command1_Click()
137  
138 +    ' build the contents of the XML packet.
139 +    xml = "<packet></packet>"
140 +
141      ' Use the first winsock control to send a UDP packet.
142 <    Winsock1.RemoteHost = Text3.Text
143 <    Winsock1.RemotePort = Text2.Text
144 <    Winsock1.SendData Text1.Text
142 >    UDPSock.RemoteHost = filterHostname
143 >    UDPSock.RemotePort = filterUDPPort
144 >    UDPSock.SendData xml
145 >    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
146  
147   End Sub
148  
149   Private Sub Command2_Click()
150      
151      ' establish a TCP connection to a filtermanager
152 <    Winsock2.Close
153 <    Winsock2.Connect Text3.Text, Text2.Text
152 >    TCPSock.Close
153 >    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
154  
155   End Sub
156  
157   Private Sub Command3_Click()
158      ' establish a TCP connection to a filter
159 <    Winsock2.Close
160 <    Winsock2.Connect filterHostname, filterTCPPort
159 >    TCPSock.Close
160 >    TCPSock.Connect filterHostname, filterTCPPort
161   End Sub
162  
163   Private Sub Form_Load()
164      protocolVersion = "1.1"
165 +    
166 +    Status.Caption = "i-scream Winhost " & protocolVersion
167 +    
168 +    ''''TEMP
169 +    filterManagerHostname = "killigrew.ukc.ac.uk"
170 +    filterManagerTCPPort = 4567
171 +    Exit Sub
172 +    ''' ENDTEMP
173 +    
174 +    On Error GoTo iniError
175 +    Dim buf As String * 256
176 +    Dim length As Long
177 +    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
178 +    filterManagerHostname = Left$(buf, length)
179 +    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
180 +    filterManagerTCPPort = Left$(buf, length)
181 +    
182 +    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
183 +    
184 +    Exit Sub
185 +    
186 + iniError:
187 +    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")
188 +    End
189 +    
190   End Sub
191  
192 < Private Sub Winsock2_Connect()
193 <      
194 <   responseNumber = 0
192 > Private Sub TCPSock_Connect()
193 >    
194 >    responseNumber = 0
195    
196      ' Send something as soon as we connect to the server.
197      If connected = False Then
198          ' contact the FilterManager
199 <        Winsock2.SendData "STARTCONFIG" & vbCrLf
199 >        TCPSock.SendData "STARTCONFIG" & vbCrLf
200      Else
201         ' Contact the Filter
202 <       Winsock2.SendData "HEARTBEAT" & vbCrLf
202 >       TCPSock.SendData "HEARTBEAT" & vbCrLf
203      End If
204    
205   End Sub
206  
207 < Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
207 > Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
208      
209      responseNumber = responseNumber + 1
210      
211      ' Get the line from the server.
212 <    Winsock2.GetData response, vbString, bytesTotal
212 >    TCPSock.GetData response, vbString, bytesTotal
213      
214      ' Remove linefeeds and returns from the line.
215      response = Replace(response, Chr(13), "")
# Line 190 | Line 222 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
222          Select Case responseNumber
223              Case 1:
224                  If Not response = "OK" Then GoTo configError
225 <                Winsock2.SendData "LASTMODIFIED" & vbCrLf
225 >                TCPSock.SendData "LASTMODIFIED" & vbCrLf
226              Case 2:
227                  If response = "ERROR" Then GoTo configError
228                  lastModified = response
229 <                Winsock2.SendData "FILELIST" & vbCrLf
229 >                TCPSock.SendData "FILELIST" & vbCrLf
230              Case 3:
231                  If response = "ERROR" Then GoTo configError
232                  fileList = response
233 <                Winsock2.SendData "UDPUpdateTime" & vbCrLf
233 >                TCPSock.SendData "UDPUpdateTime" & vbCrLf
234              Case 4:
235                  If response = "ERROR" Then GoTo configError
236 <                Winsock2.SendData "TCPUpdateTime" & vbCrLf
236 >                UDPUpdateTime = response
237 >                TCPSock.SendData "TCPUpdateTime" & vbCrLf
238              Case 5:
239                  If response = "ERROR" Then GoTo configError
240 <                Winsock2.SendData "ENDCONFIG" & vbCrLf
240 >                TCPUpdateTime = response
241 >                TCPSock.SendData "ENDCONFIG" & vbCrLf
242              Case 6:
243                  If Not response = "OK" Then GoTo configError
244 <                Winsock2.SendData "FILTER" & vbCrLf
244 >                TCPSock.SendData "FILTER" & vbCrLf
245              Case 7:
246                  'we got a filter list here.
247                  readTo = 0
# Line 221 | Line 255 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
255                  response = Mid(response, readTo + 1, Len(response))
256                  ' get TCP Port number
257                  filterTCPPort = response
258 <                Winsock2.SendData "END" & vbCrLf
258 >                TCPSock.SendData "END" & vbCrLf
259              Case 8:
260                  If Not response = "OK" Then GoTo configError
261                  connected = True
262                  responseNumber = 0
263 <                Winsock2.Close
263 >                TCPSock.Close
264                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
265 <                x = MsgBox("got config okay")
265 >                Label1.Caption = "TCP hearbeat interval: " & UDPUpdateTime
266 >                Label2.Caption = "UDP packet interval: " & TCPUpdateTime
267 >                Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
268 >                Label3.Caption = UDPUpdateTime
269 >                Label4.Caption = TCPUpdateTime
270 >                Timer1.Interval = 1000
271          End Select
272      Else
273          ' Perform a heartbeat (1.1)
# Line 236 | Line 275 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
275          Select Case responseNumber
276              Case 1:
277                  If Not response = "OK" Then GoTo heartbeatError
278 <                Winsock2.SendData "CONFIG" & vbCrLf
278 >                TCPSock.SendData "CONFIG" & vbCrLf
279              Case 2:
280                  If Not response = "OK" Then GoTo heartbeatError
281 <                Winsock2.SendData fileList & vbCrLf
281 >                TCPSock.SendData fileList & vbCrLf
282              Case 3:
283                  If Not response = "OK" Then GoTo heartbeatError
284 <                Winsock2.SendData lastModified & vbCrLf
284 >                TCPSock.SendData lastModified & vbCrLf
285              Case 4:
286                  If Not response = "OK" Then GoTo heartbeatError
287 <                Winsock2.SendData "ENDHEARTBEAT" & vbCrLf
287 >                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
288              Case 5:
289                  If Not response = "OK" Then GoTo heartbeatError
290 <                Winsock2.Close
291 <                x = MsgBox("heartbeat sent okay.")
290 >                TCPSock.Close
291 >                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
292          End Select
293      
294      End If
# Line 258 | Line 297 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
297      Exit Sub
298      
299   configError:
300 <    x = MsgBox("error doing configuration")
300 >    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
301 >    Exit Sub
302   heartbeatError:
303 +    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
304 +    Exit Sub
305 + End Sub
306 +
307 + Private Sub TCPTimer_Timer()
308      
309 +    ' establish a TCP connection to a filter
310 +    TCPSock.Close
311 +    TCPSock.Connect filterHostname, filterTCPPort
312 +
313 + End Sub
314 +
315 + Private Sub UDPTimer_Timer()
316 +    
317 +    ' build the contents of the XML packet.
318 +    xml = "<packet></packet>"
319 +
320 +    ' Use the first winsock control to send a UDP packet.
321 +    UDPSock.RemoteHost = filterHostname
322 +    UDPSock.RemotePort = filterUDPPort
323 +    UDPSock.SendData xml
324 +    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
325 +
326 + End Sub
327 +
328 + Private Sub Timer1_Timer()
329 +
330 +    Label3.Caption = Label3.Caption - 1
331 +    Label4.Caption = Label4.Caption - 1
332 +    
333 +    Status.Caption = "i-scream Winhost " & protocolVersion
334 +    
335 +    If Label3.Caption < 1 Then
336 +        ' build the contents of the XML packet.
337 +        xml = "<packet></packet>"
338 +
339 +        ' Use the first winsock control to send a UDP packet.
340 +        UDPSock.RemoteHost = filterHostname
341 +        UDPSock.RemotePort = filterUDPPort
342 +        UDPSock.SendData xml
343 +        Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
344 +        Label3.Caption = UDPUpdateTime
345 +    End If
346 +    
347 +    If Label4.Caption < 1 Then
348 +        ' establish a TCP connection to a filter
349 +        TCPSock.Close
350 +        TCPSock.Connect filterHostname, filterTCPPort
351 +        Label4.Caption = TCPUpdateTime
352 +    End If
353 +
354   End Sub

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines