ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/host/vb_net_test/nettest.frm
Revision: 1.10
Committed: Fri Feb 23 11:42:06 2001 UTC (23 years, 2 months ago) by pjm2
Branch: MAIN
Changes since 1.9: +55 -80 lines
Log Message:
Tidied up the displaying of errors on the form.

File Contents

# User Rev Content
1 pjm2 1.1 VERSION 5.00
2     Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
3     Begin VB.Form Form1
4 pjm2 1.10 BorderStyle = 4 'Fixed ToolWindow
5     Caption = "i-scream Winhost"
6 pjm2 1.1 ClientHeight = 5655
7     ClientLeft = 45
8 pjm2 1.10 ClientTop = 285
9 pjm2 1.1 ClientWidth = 5670
10     LinkTopic = "Form1"
11     MaxButton = 0 'False
12     MinButton = 0 'False
13     ScaleHeight = 5655
14     ScaleWidth = 5670
15     ShowInTaskbar = 0 'False
16     StartUpPosition = 3 'Windows Default
17 pjm2 1.8 Begin VB.Timer Timer1
18 pjm2 1.10 Left = 4200
19     Top = 1200
20 pjm2 1.1 End
21     Begin VB.TextBox Text4
22 pjm2 1.6 Height = 1575
23 pjm2 1.1 Left = 240
24     MultiLine = -1 'True
25     ScrollBars = 2 'Vertical
26 pjm2 1.10 TabIndex = 1
27 pjm2 1.1 Text = "nettest.frx":0000
28     Top = 3000
29     Width = 5055
30     End
31 pjm2 1.10 Begin VB.CommandButton Reconfigure
32     Caption = "Reconfigure with FilterManager"
33     Height = 495
34     Left = 120
35     TabIndex = 0
36     Top = 120
37     Width = 2895
38 pjm2 1.1 End
39 pjm2 1.5 Begin MSWinsockLib.Winsock TCPSock
40 pjm2 1.10 Left = 5160
41     Top = 1200
42 pjm2 1.1 _ExtentX = 741
43     _ExtentY = 741
44     _Version = 393216
45     End
46 pjm2 1.5 Begin MSWinsockLib.Winsock UDPSock
47 pjm2 1.10 Left = 4680
48     Top = 1200
49 pjm2 1.1 _ExtentX = 741
50     _ExtentY = 741
51     _Version = 393216
52     Protocol = 1
53     End
54 pjm2 1.9 Begin VB.Label Label2
55     Alignment = 1 'Right Justify
56     Caption = "Next heartbeat:"
57 pjm2 1.8 Height = 255
58 pjm2 1.10 Left = 3360
59     TabIndex = 6
60 pjm2 1.9 Top = 480
61     Width = 1455
62 pjm2 1.8 End
63 pjm2 1.9 Begin VB.Label Label1
64     Alignment = 1 'Right Justify
65     Caption = "Next UDP packet:"
66 pjm2 1.8 Height = 255
67 pjm2 1.10 Left = 3360
68     TabIndex = 5
69 pjm2 1.9 Top = 120
70     Width = 1455
71 pjm2 1.8 End
72 pjm2 1.9 Begin VB.Label Label4
73 pjm2 1.10 BorderStyle = 1 'Fixed Single
74 pjm2 1.9 Caption = "0"
75 pjm2 1.7 Height = 255
76 pjm2 1.10 Left = 4920
77     TabIndex = 4
78 pjm2 1.9 Top = 480
79     Width = 615
80 pjm2 1.7 End
81 pjm2 1.9 Begin VB.Label Label3
82 pjm2 1.10 BorderStyle = 1 'Fixed Single
83 pjm2 1.9 Caption = "0"
84 pjm2 1.7 Height = 255
85 pjm2 1.10 Left = 4920
86     TabIndex = 3
87 pjm2 1.9 Top = 120
88     Width = 615
89 pjm2 1.7 End
90 pjm2 1.6 Begin VB.Label Status
91     Caption = "Status:"
92 pjm2 1.1 Height = 255
93 pjm2 1.6 Left = 120
94 pjm2 1.10 TabIndex = 2
95     Top = 840
96 pjm2 1.6 Width = 5415
97 pjm2 1.1 End
98     End
99     Attribute VB_Name = "Form1"
100     Attribute VB_GlobalNameSpace = False
101     Attribute VB_Creatable = False
102     Attribute VB_PredeclaredId = True
103     Attribute VB_Exposed = False
104 pjm2 1.4 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
105     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
106    
107     Dim filterManagerHostname As String
108     Dim filterManagerTCPPort As Integer
109    
110 pjm2 1.2 Dim filterHostname As String
111 pjm2 1.3 Dim filterTCPPort As Integer
112     Dim filterUDPPort As Integer
113     Dim fileList As String
114     Dim lastModified As String
115 pjm2 1.2
116 pjm2 1.7 Dim UDPUpdateTime As Integer
117     Dim TCPUpdateTime As Integer
118    
119 pjm2 1.2 Dim protocolVersion As String
120     Dim connected As Boolean
121 pjm2 1.1 Dim responseNumber As Integer
122    
123    
124     Private Sub Command1_Click()
125    
126 pjm2 1.5 ' build the contents of the XML packet.
127 pjm2 1.4 xml = "<packet></packet>"
128    
129 pjm2 1.2 ' Use the first winsock control to send a UDP packet.
130 pjm2 1.5 UDPSock.RemoteHost = filterHostname
131     UDPSock.RemotePort = filterUDPPort
132     UDPSock.SendData xml
133 pjm2 1.6 Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
134 pjm2 1.1
135     End Sub
136    
137    
138     Private Sub Command3_Click()
139 pjm2 1.3 ' establish a TCP connection to a filter
140 pjm2 1.5 TCPSock.Close
141     TCPSock.Connect filterHostname, filterTCPPort
142 pjm2 1.1 End Sub
143    
144 pjm2 1.2 Private Sub Form_Load()
145     protocolVersion = "1.1"
146 pjm2 1.10
147     Status.Caption = "Loading"
148     Form1.Caption = "i-scream Winhost " & protocolVersion
149 pjm2 1.6
150 pjm2 1.4 ''''TEMP
151     filterManagerHostname = "killigrew.ukc.ac.uk"
152     filterManagerTCPPort = 4567
153 pjm2 1.10 Reconfigure_Click
154 pjm2 1.4 Exit Sub
155     ''' ENDTEMP
156    
157     On Error GoTo iniError
158     Dim buf As String * 256
159     Dim length As Long
160     length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
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    
165 pjm2 1.10 Status.Caption = "Connecting to Filter Manager"
166 pjm2 1.6
167 pjm2 1.4 Exit Sub
168    
169     iniError:
170     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")
171     End
172    
173     End Sub
174    
175 pjm2 1.10 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
176     x = MsgBox("Are you sure you want to shut down the Winhost?", vbYesNo, "i-scream Winhost")
177     If x = 7 Then
178     Cancel = True
179     End If
180    
181     End Sub
182    
183     Private Sub Reconfigure_Click()
184     ' establish a TCP connection to a filtermanager
185     connected = False
186     TCPSock.Close
187     TCPSock.Connect filterManagerHostname, filterManagerTCPPort
188     End Sub
189    
190 pjm2 1.5 Private Sub TCPSock_Connect()
191 pjm2 1.6
192     responseNumber = 0
193 pjm2 1.1
194 pjm2 1.3 ' Send something as soon as we connect to the server.
195     If connected = False Then
196     ' contact the FilterManager
197 pjm2 1.5 TCPSock.SendData "STARTCONFIG" & vbCrLf
198 pjm2 1.3 Else
199     ' Contact the Filter
200 pjm2 1.5 TCPSock.SendData "HEARTBEAT" & vbCrLf
201 pjm2 1.3 End If
202 pjm2 1.1
203     End Sub
204    
205 pjm2 1.5 Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
206 pjm2 1.1
207     responseNumber = responseNumber + 1
208    
209     ' Get the line from the server.
210 pjm2 1.5 TCPSock.GetData response, vbString, bytesTotal
211 pjm2 1.1
212     ' Remove linefeeds and returns from the line.
213     response = Replace(response, Chr(13), "")
214     response = Replace(response, Chr(10), "")
215     Text4.Text = Text4.Text & vbCrLf & response
216    
217 pjm2 1.2 If connected = False Then
218     ' Perform TCP configuration (1.1)
219     On Error GoTo configError
220     Select Case responseNumber
221     Case 1:
222     If Not response = "OK" Then GoTo configError
223 pjm2 1.5 TCPSock.SendData "LASTMODIFIED" & vbCrLf
224 pjm2 1.2 Case 2:
225     If response = "ERROR" Then GoTo configError
226 pjm2 1.3 lastModified = response
227 pjm2 1.5 TCPSock.SendData "FILELIST" & vbCrLf
228 pjm2 1.2 Case 3:
229     If response = "ERROR" Then GoTo configError
230 pjm2 1.3 fileList = response
231 pjm2 1.5 TCPSock.SendData "UDPUpdateTime" & vbCrLf
232 pjm2 1.2 Case 4:
233     If response = "ERROR" Then GoTo configError
234 pjm2 1.7 UDPUpdateTime = response
235 pjm2 1.5 TCPSock.SendData "TCPUpdateTime" & vbCrLf
236 pjm2 1.2 Case 5:
237     If response = "ERROR" Then GoTo configError
238 pjm2 1.7 TCPUpdateTime = response
239 pjm2 1.5 TCPSock.SendData "ENDCONFIG" & vbCrLf
240 pjm2 1.2 Case 6:
241     If Not response = "OK" Then GoTo configError
242 pjm2 1.5 TCPSock.SendData "FILTER" & vbCrLf
243 pjm2 1.2 Case 7:
244     'we got a filter list here.
245     readTo = 0
246     ' get hostname
247     readTo = InStr(1, response, ";", vbBinaryCompare)
248     filterHostname = Mid(response, 1, readTo - 1)
249     response = Mid(response, readTo + 1, Len(response))
250     ' get UDP Port number
251     readTo = InStr(1, response, ";")
252     filterUDPPort = Mid(response, 1, readTo - 1)
253     response = Mid(response, readTo + 1, Len(response))
254     ' get TCP Port number
255     filterTCPPort = response
256 pjm2 1.5 TCPSock.SendData "END" & vbCrLf
257 pjm2 1.2 Case 8:
258     If Not response = "OK" Then GoTo configError
259     connected = True
260     responseNumber = 0
261 pjm2 1.5 TCPSock.Close
262 pjm2 1.2 Text4.Text = Text4.Text & vbCrLf & " <closed>"
263 pjm2 1.10 Status.Caption = "Configuration successful"
264 pjm2 1.8 Label3.Caption = UDPUpdateTime
265     Label4.Caption = TCPUpdateTime
266     Timer1.Interval = 1000
267 pjm2 1.2 End Select
268     Else
269     ' Perform a heartbeat (1.1)
270     On Error GoTo heartbeatError
271     Select Case responseNumber
272     Case 1:
273 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
274 pjm2 1.5 TCPSock.SendData "CONFIG" & vbCrLf
275 pjm2 1.2 Case 2:
276 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
277 pjm2 1.5 TCPSock.SendData fileList & vbCrLf
278 pjm2 1.2 Case 3:
279 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
280 pjm2 1.5 TCPSock.SendData lastModified & vbCrLf
281 pjm2 1.2 Case 4:
282 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
283 pjm2 1.5 TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
284 pjm2 1.2 Case 5:
285 pjm2 1.3 If Not response = "OK" Then GoTo heartbeatError
286 pjm2 1.5 TCPSock.Close
287 pjm2 1.10 Status.Caption = "Heartbeat sent successfully."
288 pjm2 1.2 End Select
289    
290     End If
291    
292    
293     Exit Sub
294    
295     configError:
296 pjm2 1.10 Status.Caption = "FAILED to get configuration"
297 pjm2 1.8 Exit Sub
298 pjm2 1.2 heartbeatError:
299 pjm2 1.10 Status.Caption = "Heatbeat FAILED"
300 pjm2 1.8 Exit Sub
301 pjm2 1.1 End Sub
302 pjm2 1.5
303 pjm2 1.8 Private Sub Timer1_Timer()
304    
305     Label3.Caption = Label3.Caption - 1
306     Label4.Caption = Label4.Caption - 1
307    
308 pjm2 1.10 Status.Caption = ""
309 pjm2 1.8
310     If Label3.Caption < 1 Then
311     ' build the contents of the XML packet.
312     xml = "<packet></packet>"
313    
314     ' Use the first winsock control to send a UDP packet.
315     UDPSock.RemoteHost = filterHostname
316     UDPSock.RemotePort = filterUDPPort
317     UDPSock.SendData xml
318 pjm2 1.10 Status.Caption = "UDP packet sent"
319 pjm2 1.8 Label3.Caption = UDPUpdateTime
320     End If
321    
322     If Label4.Caption < 1 Then
323     ' establish a TCP connection to a filter
324     TCPSock.Close
325     TCPSock.Connect filterHostname, filterTCPPort
326     Label4.Caption = TCPUpdateTime
327     End If
328    
329     End Sub