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

Comparing experimental/host/vb_net_test/nettest.frm (file contents):
Revision 1.4 by pjm2, Fri Feb 23 10:29:16 2001 UTC vs.
Revision 1.16 by pjm2, Fri Feb 23 17:31:44 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        =   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 Winsock2
56 <      Left            =   4920
57 <      Top             =   120
55 >   Begin MSWinsockLib.Winsock TCPSock
56 >      Left            =   3720
57 >      Top             =   1800
58        _ExtentX        =   741
59        _ExtentY        =   741
60        _Version        =   393216
61     End
62 <   Begin VB.CommandButton Command1
63 <      Caption         =   "Send UDP"
64 <      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
66 <   Begin MSWinsockLib.Winsock Winsock1
67 <      Left            =   4320
68 <      Top             =   120
62 >   Begin MSWinsockLib.Winsock UDPSock
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
118   Attribute VB_Creatable = False
119   Attribute VB_PredeclaredId = True
120   Attribute VB_Exposed = False
121 + ' For the system tray bits
122   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
123   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
124  
125   Dim filterManagerHostname As String
126   Dim filterManagerTCPPort As Integer
127  
128 + Dim seqNo As Long
129 + Dim machineName As String
130 +
131   Dim filterHostname As String
132   Dim filterTCPPort As Integer
133   Dim filterUDPPort As Integer
134   Dim fileList As String
135   Dim lastModified As String
136  
137 + Dim UDPUpdateTime As Integer
138 + Dim TCPUpdateTime As Integer
139 +
140   Dim protocolVersion As String
141   Dim connected As Boolean
102 Dim responseNumber As Integer
142  
143 + 'Dim CUpTime As New CUpTime
144  
145 < Private Sub Command1_Click()
145 > Dim responseNumber As Integer
146  
107    xml = "<packet></packet>"
108
109    ' Use the first winsock control to send a UDP packet.
110    Winsock1.RemoteHost = filterHostname
111    Winsock1.RemotePort = filterUDPPort
112    Winsock1.SendData xml
113
114 End Sub
115
116 Private Sub Command2_Click()
117    
118    ' establish a TCP connection to a filtermanager
119    Winsock2.Close
120    Winsock2.Connect filterManagerHostname, filterManagerTCPPort
121
122 End Sub
123
124 Private Sub Command3_Click()
125    ' establish a TCP connection to a filter
126    Winsock2.Close
127    Winsock2.Connect filterHostname, filterTCPPort
128 End Sub
129
147   Private Sub Form_Load()
148 +    
149      protocolVersion = "1.1"
150      
151 +    Status.Caption = "Loading"
152 +    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
153 +    
154      ''''TEMP
155      filterManagerHostname = "killigrew.ukc.ac.uk"
156      filterManagerTCPPort = 4567
157 <    Exit Sub
137 <    ''' ENDTEMP
157 >    ''''' END TEMP
158      
159 +    GoTo skip
160      On Error GoTo iniError
161      Dim buf As String * 256
162      Dim length As Long
# Line 143 | Line 164 | Private Sub Form_Load()
164      filterManagerHostname = Left$(buf, length)
165      length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
166      filterManagerTCPPort = Left$(buf, length)
167 + skip:
168 +
169 +    Status.Caption = "Connecting to Filter Manager"
170 +    Reconfigure_Click
171      
172 +    Form1.Show
173 +    SystemTray.Action = 0
174 +    
175 +    
176      Exit Sub
177      
178   iniError:
# Line 152 | Line 181 | iniError:
181      
182   End Sub
183  
184 < Private Sub Label2_Click()
184 > Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
185 >    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")
186 >    If x = 7 Then
187 >        Cancel = True
188 >    Else
189 >        SystemTray.Action = 2
190 >    End If
191  
192   End Sub
193  
194 < Private Sub Winsock2_Connect()
195 <      
196 <   responseNumber = 0
194 > Private Sub Hide_Click()
195 >    Form1.Visible = False
196 >    SystemTray.Icon = Val(Form1.Icon)
197 > End Sub
198 >
199 > Private Sub Reconfigure_Click()
200 >    ' establish a TCP connection to a filtermanager
201 >    connected = False
202 >    TCPSock.Close
203 >    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
204 > End Sub
205 >
206 >
207 >
208 > Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
209 >
210 >    Form1.Visible = True
211 >    Form1.SetFocus
212 >    
213 >
214 > End Sub
215 >
216 > Private Sub TCPSock_Connect()
217 >    
218 >    responseNumber = 0
219    
220      ' Send something as soon as we connect to the server.
221      If connected = False Then
222          ' contact the FilterManager
223 <        Winsock2.SendData "STARTCONFIG" & vbCrLf
223 >        TCPSock.SendData "STARTCONFIG" & vbCrLf
224      Else
225         ' Contact the Filter
226 <       Winsock2.SendData "HEARTBEAT" & vbCrLf
226 >       TCPSock.SendData "HEARTBEAT" & vbCrLf
227      End If
228    
229   End Sub
230  
231 < Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
231 > Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
232      
233      responseNumber = responseNumber + 1
234      
235      ' Get the line from the server.
236 <    Winsock2.GetData response, vbString, bytesTotal
236 >    TCPSock.GetData response, vbString, bytesTotal
237      
238      ' Remove linefeeds and returns from the line.
239      response = Replace(response, Chr(13), "")
# Line 189 | Line 246 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
246          Select Case responseNumber
247              Case 1:
248                  If Not response = "OK" Then GoTo configError
249 <                Winsock2.SendData "LASTMODIFIED" & vbCrLf
249 >                TCPSock.SendData "LASTMODIFIED" & vbCrLf
250              Case 2:
251                  If response = "ERROR" Then GoTo configError
252                  lastModified = response
253 <                Winsock2.SendData "FILELIST" & vbCrLf
253 >                TCPSock.SendData "FILELIST" & vbCrLf
254              Case 3:
255                  If response = "ERROR" Then GoTo configError
256                  fileList = response
257 <                Winsock2.SendData "UDPUpdateTime" & vbCrLf
257 >                TCPSock.SendData "UDPUpdateTime" & vbCrLf
258              Case 4:
259                  If response = "ERROR" Then GoTo configError
260 <                Winsock2.SendData "TCPUpdateTime" & vbCrLf
260 >                UDPUpdateTime = response
261 >                TCPSock.SendData "TCPUpdateTime" & vbCrLf
262              Case 5:
263                  If response = "ERROR" Then GoTo configError
264 <                Winsock2.SendData "ENDCONFIG" & vbCrLf
264 >                TCPUpdateTime = response
265 >                TCPSock.SendData "ENDCONFIG" & vbCrLf
266              Case 6:
267                  If Not response = "OK" Then GoTo configError
268 <                Winsock2.SendData "FILTER" & vbCrLf
268 >                TCPSock.SendData "FILTER" & vbCrLf
269              Case 7:
270                  'we got a filter list here.
271                  readTo = 0
# Line 220 | Line 279 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
279                  response = Mid(response, readTo + 1, Len(response))
280                  ' get TCP Port number
281                  filterTCPPort = response
282 <                Winsock2.SendData "END" & vbCrLf
282 >                TCPSock.SendData "END" & vbCrLf
283              Case 8:
284                  If Not response = "OK" Then GoTo configError
285                  connected = True
286                  responseNumber = 0
287 <                Winsock2.Close
287 >                TCPSock.Close
288                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
289 <                x = MsgBox("got config okay")
289 >                Status.Caption = "Configuration successful"
290 >                Label3.Caption = UDPUpdateTime
291 >                Label4.Caption = TCPUpdateTime
292 >                Timer1.Interval = 1000
293          End Select
294      Else
295          ' Perform a heartbeat (1.1)
# Line 235 | Line 297 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
297          Select Case responseNumber
298              Case 1:
299                  If Not response = "OK" Then GoTo heartbeatError
300 <                Winsock2.SendData "CONFIG" & vbCrLf
300 >                TCPSock.SendData "CONFIG" & vbCrLf
301              Case 2:
302                  If Not response = "OK" Then GoTo heartbeatError
303 <                Winsock2.SendData fileList & vbCrLf
303 >                TCPSock.SendData fileList & vbCrLf
304              Case 3:
305                  If Not response = "OK" Then GoTo heartbeatError
306 <                Winsock2.SendData lastModified & vbCrLf
306 >                TCPSock.SendData lastModified & vbCrLf
307              Case 4:
308                  If Not response = "OK" Then GoTo heartbeatError
309 <                Winsock2.SendData "ENDHEARTBEAT" & vbCrLf
309 >                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
310              Case 5:
311                  If Not response = "OK" Then GoTo heartbeatError
312 <                Winsock2.Close
313 <                x = MsgBox("heartbeat sent okay.")
312 >                TCPSock.Close
313 >                Status.Caption = "Heartbeat sent successfully."
314          End Select
315      
316      End If
# Line 257 | Line 319 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
319      Exit Sub
320      
321   configError:
322 <    x = MsgBox("error doing configuration")
322 >    Status.Caption = "FAILED to get configuration"
323 >    Exit Sub
324   heartbeatError:
325 <    x = MsgBox("error doing configuration")
325 >    Status.Caption = "Heatbeat FAILED"
326 >    Exit Sub
327   End Sub
328 +
329 + Private Sub Timer1_Timer()
330 +
331 +    Label3.Caption = Label3.Caption - 1
332 +    Label4.Caption = Label4.Caption - 1
333 +    
334 +    Status.Caption = ""
335 +    
336 +    If Label3.Caption < 1 Then
337 +        
338 +        ' prepare the contents of the XML packet.
339 +        seqNo = seqNo + 1
340 +        machineName = TCPSock.LocalHostName
341 +        LocalIP = TCPSock.LocalIP
342 +        packetDate = Date2Num()
343 +        
344 +        
345 +        Dim verinfo As OSVERSIONINFO
346 +        verinfo.dwOSVersionInfoSize = Len(verinfo)
347 +        ret% = GetVersionEx(verinfo)
348 +        If ret% = 0 Then
349 +            MsgBox "Error getting Windows version Information"
350 +            End
351 +        End If
352 +          
353 +        osName = getVersion()
354 +        osVersionMajor = verinfo.dwMajorVersion
355 +        osVersionMinor = verinfo.dwMinorVersion
356 +        osBuild = verinfo.dwBuildNumber
357 +        
358 +        Dim sysinfo As SYSTEM_INFO
359 +        GetSystemInfo sysinfo
360 +        Select Case sysinfo.dwProcessorType
361 +            Case PROCESSOR_INTEL_386
362 +                processorType = "Intel 386"
363 +            Case PROCESSOR_INTEL_486
364 +                processorType = "Intel 486"
365 +            Case PROCESSOR_INTEL_PENTIUM
366 +                processorType = "Intel Pentium variant"
367 +            Case PROCESSOR_MIPS_R4000
368 +                processorType = "MIPS R4000"
369 +            Case PROCESSOR_ALPHA_21064
370 +                processorType = "DEC Alpha 21064"
371 +            Case Else
372 +                processorType = "(unknown)"
373 +        End Select
374 +        
375 +        Dim memsts As MEMORYSTATUS
376 +        Dim memory&
377 +        GlobalMemoryStatus memsts
378 +        memory& = memsts.dwTotalPhys
379 +        memTotal = memory& \ 1024
380 +        memory& = memsts.dwAvailPhys
381 +        memFree = memory& \ 1024
382 +        memory& = memsts.dwTotalVirtual
383 +        swapTotal = memory& \ 1024
384 +        memory& = memsts.dwAvailVirtual
385 +        swapFree = memory& \ 1024
386 +        
387 +        ' build the contents of the XML packet
388 +        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
389 +              "<os>" & _
390 +                "<name>" & osName & "</name>" & _
391 +                "<version>" & osVersionMajor & "</version>" & _
392 +                "<release>" & osBuild & "</release>" & _
393 +                "<platform>" & osName & "</platform>" & _
394 +                "<minor_version>" & osVersionMinor & "</minor_version>" & _
395 +                "<processor>" & processorType & "</processor>" & _
396 +              "</os>" & _
397 +              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
398 +              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
399 +              ""
400 +        Text4.Text = Text4.Text + xml
401 +
402 +        ' Use the first winsock control to send a UDP packet.
403 +        UDPSock.RemoteHost = filterHostname
404 +        UDPSock.RemotePort = filterUDPPort
405 +        UDPSock.SendData xml
406 +        Status.Caption = "UDP packet sent"
407 +        Label3.Caption = UDPUpdateTime
408 +    End If
409 +    
410 +    If Label4.Caption < 1 Then
411 +        ' establish a TCP connection to a filter
412 +        TCPSock.Close
413 +        TCPSock.Connect filterHostname, filterTCPPort
414 +        Label4.Caption = TCPUpdateTime
415 +    End If
416 +
417 + End Sub
418 +
419 + Function Date2Num() As Long
420 +    Dim x As Long
421 +    x = DateDiff("s", "1-1-1970", Now)
422 +    Date2Num = x
423 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines