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.7 by pjm2, Fri Feb 23 10:58:00 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 TCPTimer
18 +      Left            =   3360
19 +      Top             =   120
20 +   End
21 +   Begin VB.Timer UDPTimer
22 +      Left            =   3840
23 +      Top             =   120
24 +   End
25     Begin VB.CommandButton Command3
26        Caption         =   "TCP to Filter"
27        Height          =   375
28        Left            =   3720
29 <      TabIndex        =   9
29 >      TabIndex        =   3
30        Top             =   2520
31        Width           =   1575
32     End
33     Begin VB.TextBox Text4
34 <      Height          =   2535
34 >      Height          =   1575
35        Left            =   240
36        MultiLine       =   -1  'True
37        ScrollBars      =   2  'Vertical
38 <      TabIndex        =   8
38 >      TabIndex        =   2
39        Text            =   "nettest.frx":0000
40        Top             =   3000
41        Width           =   5055
# Line 36 | Line 44 | Begin VB.Form Form1
44        Caption         =   "TCP to FilterManager"
45        Height          =   375
46        Left            =   3360
47 <      TabIndex        =   7
47 >      TabIndex        =   1
48        Top             =   2040
49        Width           =   1935
50     End
51 <   Begin MSWinsockLib.Winsock Winsock2
51 >   Begin MSWinsockLib.Winsock TCPSock
52        Left            =   4920
53        Top             =   120
54        _ExtentX        =   741
55        _ExtentY        =   741
56        _Version        =   393216
57     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
58     Begin VB.CommandButton Command1
59        Caption         =   "Send UDP"
60        Height          =   375
61        Left            =   4320
62 <      TabIndex        =   2
62 >      TabIndex        =   0
63        Top             =   1560
64        Width           =   975
65     End
66 <   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
66 >   Begin MSWinsockLib.Winsock UDPSock
67        Left            =   4320
68        Top             =   120
69        _ExtentX        =   741
# Line 87 | Line 71 | Begin VB.Form Form1
71        _Version        =   393216
72        Protocol        =   1
73     End
74 <   Begin VB.Label Label3
75 <      Alignment       =   1  'Right Justify
92 <      Caption         =   "Destination:"
74 >   Begin VB.Label Label2
75 >      Caption         =   "Label2"
76        Height          =   255
77 <      Left            =   360
77 >      Left            =   120
78        TabIndex        =   6
79 <      Top             =   1560
80 <      Width           =   1215
79 >      Top             =   600
80 >      Width           =   3375
81     End
82 <   Begin VB.Label Label2
83 <      Alignment       =   1  'Right Justify
101 <      Caption         =   "Port:"
82 >   Begin VB.Label Label1
83 >      Caption         =   "Label1"
84        Height          =   255
85 <      Left            =   360
86 <      TabIndex        =   4
87 <      Top             =   1920
88 <      Width           =   1215
85 >      Left            =   120
86 >      TabIndex        =   5
87 >      Top             =   240
88 >      Width           =   3375
89     End
90 <   Begin VB.Label Label1
91 <      Caption         =   "Packet contents"
90 >   Begin VB.Label Status
91 >      Caption         =   "Status:"
92        Height          =   255
93 <      Left            =   360
94 <      TabIndex        =   1
95 <      Top             =   360
96 <      Width           =   2895
93 >      Left            =   120
94 >      TabIndex        =   4
95 >      Top             =   5280
96 >      Width           =   5415
97     End
98   End
99   Attribute VB_Name = "Form1"
# Line 119 | Line 101 | Attribute VB_GlobalNameSpace = False
101   Attribute VB_Creatable = False
102   Attribute VB_PredeclaredId = True
103   Attribute VB_Exposed = False
104 + 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   Dim filterHostname As String
111   Dim filterTCPPort As Integer
112   Dim filterUDPPort As Integer
113   Dim fileList As String
114   Dim lastModified As String
115  
116 + Dim UDPUpdateTime As Integer
117 + Dim TCPUpdateTime As Integer
118 +
119   Dim protocolVersion As String
120   Dim connected As Boolean
121   Dim responseNumber As Integer
# Line 132 | Line 123 | Dim responseNumber As Integer
123  
124   Private Sub Command1_Click()
125  
126 +    ' build the contents of the XML packet.
127 +    xml = "<packet></packet>"
128 +
129      ' Use the first winsock control to send a UDP packet.
130 <    Winsock1.RemoteHost = Text3.Text
131 <    Winsock1.RemotePort = Text2.Text
132 <    Winsock1.SendData Text1.Text
130 >    UDPSock.RemoteHost = filterHostname
131 >    UDPSock.RemotePort = filterUDPPort
132 >    UDPSock.SendData xml
133 >    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
134  
135   End Sub
136  
137   Private Sub Command2_Click()
138      
139      ' establish a TCP connection to a filtermanager
140 <    Winsock2.Close
141 <    Winsock2.Connect Text3.Text, Text2.Text
140 >    TCPSock.Close
141 >    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
142  
143   End Sub
144  
145   Private Sub Command3_Click()
146      ' establish a TCP connection to a filter
147 <    Winsock2.Close
148 <    Winsock2.Connect filterHostname, filterTCPPort
147 >    TCPSock.Close
148 >    TCPSock.Connect filterHostname, filterTCPPort
149   End Sub
150  
151   Private Sub Form_Load()
152      protocolVersion = "1.1"
153 +    
154 +    Status.Caption = "i-scream Winhost " & protocolVersion
155 +    
156 +    ''''TEMP
157 +    filterManagerHostname = "killigrew.ukc.ac.uk"
158 +    filterManagerTCPPort = 4567
159 +    Exit Sub
160 +    ''' ENDTEMP
161 +    
162 +    On Error GoTo iniError
163 +    Dim buf As String * 256
164 +    Dim length As Long
165 +    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
166 +    filterManagerHostname = Left$(buf, length)
167 +    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
168 +    filterManagerTCPPort = Left$(buf, length)
169 +    
170 +    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
171 +    
172 +    Exit Sub
173 +    
174 + iniError:
175 +    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")
176 +    End
177 +    
178   End Sub
179  
180 < Private Sub Winsock2_Connect()
181 <      
182 <   responseNumber = 0
180 > Private Sub TCPSock_Connect()
181 >    
182 >    responseNumber = 0
183    
184      ' Send something as soon as we connect to the server.
185      If connected = False Then
186          ' contact the FilterManager
187 <        Winsock2.SendData "STARTCONFIG" & vbCrLf
187 >        TCPSock.SendData "STARTCONFIG" & vbCrLf
188      Else
189         ' Contact the Filter
190 <       Winsock2.SendData "HEARTBEAT" & vbCrLf
190 >       TCPSock.SendData "HEARTBEAT" & vbCrLf
191      End If
192    
193   End Sub
194  
195 < Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
195 > Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
196      
197      responseNumber = responseNumber + 1
198      
199      ' Get the line from the server.
200 <    Winsock2.GetData response, vbString, bytesTotal
200 >    TCPSock.GetData response, vbString, bytesTotal
201      
202      ' Remove linefeeds and returns from the line.
203      response = Replace(response, Chr(13), "")
# Line 190 | Line 210 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
210          Select Case responseNumber
211              Case 1:
212                  If Not response = "OK" Then GoTo configError
213 <                Winsock2.SendData "LASTMODIFIED" & vbCrLf
213 >                TCPSock.SendData "LASTMODIFIED" & vbCrLf
214              Case 2:
215                  If response = "ERROR" Then GoTo configError
216                  lastModified = response
217 <                Winsock2.SendData "FILELIST" & vbCrLf
217 >                TCPSock.SendData "FILELIST" & vbCrLf
218              Case 3:
219                  If response = "ERROR" Then GoTo configError
220                  fileList = response
221 <                Winsock2.SendData "UDPUpdateTime" & vbCrLf
221 >                TCPSock.SendData "UDPUpdateTime" & vbCrLf
222              Case 4:
223                  If response = "ERROR" Then GoTo configError
224 <                Winsock2.SendData "TCPUpdateTime" & vbCrLf
224 >                UDPUpdateTime = response
225 >                TCPSock.SendData "TCPUpdateTime" & vbCrLf
226              Case 5:
227                  If response = "ERROR" Then GoTo configError
228 <                Winsock2.SendData "ENDCONFIG" & vbCrLf
228 >                TCPUpdateTime = response
229 >                TCPSock.SendData "ENDCONFIG" & vbCrLf
230              Case 6:
231                  If Not response = "OK" Then GoTo configError
232 <                Winsock2.SendData "FILTER" & vbCrLf
232 >                TCPSock.SendData "FILTER" & vbCrLf
233              Case 7:
234                  'we got a filter list here.
235                  readTo = 0
# Line 221 | Line 243 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
243                  response = Mid(response, readTo + 1, Len(response))
244                  ' get TCP Port number
245                  filterTCPPort = response
246 <                Winsock2.SendData "END" & vbCrLf
246 >                TCPSock.SendData "END" & vbCrLf
247              Case 8:
248                  If Not response = "OK" Then GoTo configError
249                  connected = True
250                  responseNumber = 0
251 <                Winsock2.Close
251 >                TCPSock.Close
252                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
253 <                x = MsgBox("got config okay")
253 >                Label1.Caption = "TCP hearbeat interval: " & UDPUpdateTime
254 >                Label2.Caption = "UDP packet interval: " & TCPUpdateTime
255 >                Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
256          End Select
257      Else
258          ' Perform a heartbeat (1.1)
# Line 236 | Line 260 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
260          Select Case responseNumber
261              Case 1:
262                  If Not response = "OK" Then GoTo heartbeatError
263 <                Winsock2.SendData "CONFIG" & vbCrLf
263 >                TCPSock.SendData "CONFIG" & vbCrLf
264              Case 2:
265                  If Not response = "OK" Then GoTo heartbeatError
266 <                Winsock2.SendData fileList & vbCrLf
266 >                TCPSock.SendData fileList & vbCrLf
267              Case 3:
268                  If Not response = "OK" Then GoTo heartbeatError
269 <                Winsock2.SendData lastModified & vbCrLf
269 >                TCPSock.SendData lastModified & vbCrLf
270              Case 4:
271                  If Not response = "OK" Then GoTo heartbeatError
272 <                Winsock2.SendData "ENDHEARTBEAT" & vbCrLf
272 >                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
273              Case 5:
274                  If Not response = "OK" Then GoTo heartbeatError
275 <                Winsock2.Close
276 <                x = MsgBox("heartbeat sent okay.")
275 >                TCPSock.Close
276 >                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
277          End Select
278      
279      End If
# Line 258 | Line 282 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
282      Exit Sub
283      
284   configError:
285 <    x = MsgBox("error doing configuration")
285 >    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration"
286   heartbeatError:
287 <    
287 >    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED"
288   End Sub
289 +

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines