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.3 by pjm2, Fri Feb 23 10:07:55 2001 UTC vs.
Revision 1.15 by pjm2, Fri Feb 23 17:08:37 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        =   9
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        =   8
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        =   7
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.TextBox Text3
63 <      Height          =   285
64 <      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
66 <   Begin VB.CommandButton Command1
67 <      Caption         =   "Send UDP"
68 <      Height          =   375
69 <      Left            =   4320
70 <      TabIndex        =   2
71 <      Top             =   1560
72 <      Width           =   975
73 <   End
74 <   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
83 <      Left            =   4320
84 <      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 Label3
70 >   Begin VB.Label Label2
71        Alignment       =   1  'Right Justify
72 <      Caption         =   "Destination:"
72 >      Caption         =   "Next heartbeat:"
73        Height          =   255
74 <      Left            =   360
74 >      Left            =   2400
75        TabIndex        =   6
76 <      Top             =   1560
77 <      Width           =   1215
76 >      Top             =   480
77 >      Width           =   1455
78     End
79 <   Begin VB.Label Label2
79 >   Begin VB.Label Label1
80        Alignment       =   1  'Right Justify
81 <      Caption         =   "Port:"
81 >      Caption         =   "Next UDP packet:"
82        Height          =   255
83 <      Left            =   360
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             =   1920
95 <      Width           =   1215
94 >      Top             =   480
95 >      Width           =   615
96     End
97 <   Begin VB.Label Label1
98 <      Caption         =   "Packet contents"
97 >   Begin VB.Label Label3
98 >      BorderStyle     =   1  'Fixed Single
99 >      Caption         =   "0"
100        Height          =   255
101 <      Left            =   360
102 <      TabIndex        =   1
103 <      Top             =   360
104 <      Width           =   2895
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
142   Dim responseNumber As Integer
143  
144 + Private Sub Form_Load()
145 +    
146 +    protocolVersion = "1.1"
147 +    
148 +    Status.Caption = "Loading"
149 +    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
150 +    
151 +    ''''TEMP
152 +    filterManagerHostname = "killigrew.ukc.ac.uk"
153 +    filterManagerTCPPort = 4567
154 +    ''''' END TEMP
155 +    
156 +    GoTo skip
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 + skip:
165  
166 < Private Sub Command1_Click()
166 >    Status.Caption = "Connecting to Filter Manager"
167 >    Reconfigure_Click
168 >    
169 >    Form1.Show
170 >    SystemTray.Action = 0
171 >    
172 >    
173 >    Exit Sub
174 >    
175 > iniError:
176 >    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")
177 >    End
178 >    
179 > End Sub
180  
181 <    ' Use the first winsock control to send a UDP packet.
182 <    Winsock1.RemoteHost = Text3.Text
183 <    Winsock1.RemotePort = Text2.Text
184 <    Winsock1.SendData Text1.Text
181 > Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
182 >    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")
183 >    If x = 7 Then
184 >        Cancel = True
185 >    Else
186 >        SystemTray.Action = 2
187 >    End If
188  
189   End Sub
190  
191 < Private Sub Command2_Click()
192 <    
193 <    ' establish a TCP connection to a filtermanager
145 <    Winsock2.Close
146 <    Winsock2.Connect Text3.Text, Text2.Text
147 <
191 > Private Sub Hide_Click()
192 >    Form1.Visible = False
193 >    SystemTray.Icon = Val(Form1.Icon)
194   End Sub
195  
196 < Private Sub Command3_Click()
197 <    ' establish a TCP connection to a filter
198 <    Winsock2.Close
199 <    Winsock2.Connect filterHostname, filterTCPPort
196 > Private Sub Reconfigure_Click()
197 >    ' establish a TCP connection to a filtermanager
198 >    connected = False
199 >    TCPSock.Close
200 >    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
201   End Sub
202  
203 < Private Sub Form_Load()
204 <    protocolVersion = "1.1"
203 >
204 >
205 > Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
206 >
207 >    Form1.Visible = True
208 >    Form1.SetFocus
209 >    
210 >
211   End Sub
212  
213 < Private Sub Winsock2_Connect()
214 <      
215 <   responseNumber = 0
213 > Private Sub TCPSock_Connect()
214 >    
215 >    responseNumber = 0
216    
217      ' Send something as soon as we connect to the server.
218      If connected = False Then
219          ' contact the FilterManager
220 <        Winsock2.SendData "STARTCONFIG" & vbCrLf
220 >        TCPSock.SendData "STARTCONFIG" & vbCrLf
221      Else
222         ' Contact the Filter
223 <       Winsock2.SendData "HEARTBEAT" & vbCrLf
223 >       TCPSock.SendData "HEARTBEAT" & vbCrLf
224      End If
225    
226   End Sub
227  
228 < Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
228 > Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
229      
230      responseNumber = responseNumber + 1
231      
232      ' Get the line from the server.
233 <    Winsock2.GetData response, vbString, bytesTotal
233 >    TCPSock.GetData response, vbString, bytesTotal
234      
235      ' Remove linefeeds and returns from the line.
236      response = Replace(response, Chr(13), "")
# Line 190 | Line 243 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
243          Select Case responseNumber
244              Case 1:
245                  If Not response = "OK" Then GoTo configError
246 <                Winsock2.SendData "LASTMODIFIED" & vbCrLf
246 >                TCPSock.SendData "LASTMODIFIED" & vbCrLf
247              Case 2:
248                  If response = "ERROR" Then GoTo configError
249                  lastModified = response
250 <                Winsock2.SendData "FILELIST" & vbCrLf
250 >                TCPSock.SendData "FILELIST" & vbCrLf
251              Case 3:
252                  If response = "ERROR" Then GoTo configError
253                  fileList = response
254 <                Winsock2.SendData "UDPUpdateTime" & vbCrLf
254 >                TCPSock.SendData "UDPUpdateTime" & vbCrLf
255              Case 4:
256                  If response = "ERROR" Then GoTo configError
257 <                Winsock2.SendData "TCPUpdateTime" & vbCrLf
257 >                UDPUpdateTime = response
258 >                TCPSock.SendData "TCPUpdateTime" & vbCrLf
259              Case 5:
260                  If response = "ERROR" Then GoTo configError
261 <                Winsock2.SendData "ENDCONFIG" & vbCrLf
261 >                TCPUpdateTime = response
262 >                TCPSock.SendData "ENDCONFIG" & vbCrLf
263              Case 6:
264                  If Not response = "OK" Then GoTo configError
265 <                Winsock2.SendData "FILTER" & vbCrLf
265 >                TCPSock.SendData "FILTER" & vbCrLf
266              Case 7:
267                  'we got a filter list here.
268                  readTo = 0
# Line 221 | Line 276 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
276                  response = Mid(response, readTo + 1, Len(response))
277                  ' get TCP Port number
278                  filterTCPPort = response
279 <                Winsock2.SendData "END" & vbCrLf
279 >                TCPSock.SendData "END" & vbCrLf
280              Case 8:
281                  If Not response = "OK" Then GoTo configError
282                  connected = True
283                  responseNumber = 0
284 <                Winsock2.Close
284 >                TCPSock.Close
285                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
286 <                x = MsgBox("got config okay")
286 >                Status.Caption = "Configuration successful"
287 >                Label3.Caption = UDPUpdateTime
288 >                Label4.Caption = TCPUpdateTime
289 >                Timer1.Interval = 1000
290          End Select
291      Else
292          ' Perform a heartbeat (1.1)
# Line 236 | Line 294 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
294          Select Case responseNumber
295              Case 1:
296                  If Not response = "OK" Then GoTo heartbeatError
297 <                Winsock2.SendData "CONFIG" & vbCrLf
297 >                TCPSock.SendData "CONFIG" & vbCrLf
298              Case 2:
299                  If Not response = "OK" Then GoTo heartbeatError
300 <                Winsock2.SendData fileList & vbCrLf
300 >                TCPSock.SendData fileList & vbCrLf
301              Case 3:
302                  If Not response = "OK" Then GoTo heartbeatError
303 <                Winsock2.SendData lastModified & vbCrLf
303 >                TCPSock.SendData lastModified & vbCrLf
304              Case 4:
305                  If Not response = "OK" Then GoTo heartbeatError
306 <                Winsock2.SendData "ENDHEARTBEAT" & vbCrLf
306 >                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
307              Case 5:
308                  If Not response = "OK" Then GoTo heartbeatError
309 <                Winsock2.Close
310 <                x = MsgBox("heartbeat sent okay.")
309 >                TCPSock.Close
310 >                Status.Caption = "Heartbeat sent successfully."
311          End Select
312      
313      End If
# Line 258 | Line 316 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
316      Exit Sub
317      
318   configError:
319 <    x = MsgBox("error doing configuration")
319 >    Status.Caption = "FAILED to get configuration"
320 >    Exit Sub
321   heartbeatError:
322 +    Status.Caption = "Heatbeat FAILED"
323 +    Exit Sub
324 + End Sub
325 +
326 + Private Sub Timer1_Timer()
327 +
328 +    Label3.Caption = Label3.Caption - 1
329 +    Label4.Caption = Label4.Caption - 1
330      
331 +    Status.Caption = ""
332 +    
333 +    If Label3.Caption < 1 Then
334 +        
335 +        ' prepare the contents of the XML packet.
336 +        seqNo = seqNo + 1
337 +        machineName = TCPSock.LocalHostName
338 +        localIP = TCPSock.localIP
339 +        packetDate = Date2Num()
340 +        
341 +        
342 +        Dim verinfo As OSVERSIONINFO
343 +        verinfo.dwOSVersionInfoSize = Len(verinfo)
344 +        ret% = GetVersionEx(verinfo)
345 +        If ret% = 0 Then
346 +            MsgBox "Error getting Windows version Information"
347 +            End
348 +        End If
349 +          
350 +        osName = getVersion()
351 +        osVersionMajor = verinfo.dwMajorVersion
352 +        osVersionMinor = verinfo.dwMinorVersion
353 +        osBuild = verinfo.dwBuildNumber
354 +        
355 +        Dim sysinfo As SYSTEM_INFO
356 +        GetSystemInfo sysinfo
357 +        Select Case sysinfo.dwProcessorType
358 +            Case PROCESSOR_INTEL_386
359 +                processorType = "Intel 386"
360 +            Case PROCESSOR_INTEL_486
361 +                processorType = "Intel 486"
362 +            Case PROCESSOR_INTEL_PENTIUM
363 +                processorType = "Intel Pentium variant"
364 +            Case PROCESSOR_MIPS_R4000
365 +                processorType = "MIPS R4000"
366 +            Case PROCESSOR_ALPHA_21064
367 +                processorType = "DEC Alpha 21064"
368 +            Case Else
369 +                processorType = "(unknown)"
370 +        End Select
371 +        
372 +        Dim memsts As MEMORYSTATUS
373 +        Dim memory&
374 +        GlobalMemoryStatus memsts
375 +        memory& = memsts.dwTotalPhys
376 +        memTotal = memory& \ 1024
377 +        memory& = memsts.dwAvailPhys
378 +        memFree = memory& \ 1024
379 +        memory& = memsts.dwTotalVirtual
380 +        swapTotal = memory& \ 1024
381 +        memory& = memsts.dwAvailVirtual
382 +        swapFree = memory& \ 1024
383 +        
384 +        ' build the contents of the XML packet
385 +        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
386 +              "<os>" & _
387 +                "<name>" & osName & "</name>" & _
388 +                "<version>" & osVersionMajor & "</version>" & _
389 +                "<release>" & osBuild & "</release>" & _
390 +                "<platform>" & osName & "</platform>" & _
391 +                "<minor_version>" & osVersionMinor & "</minor_version>" & _
392 +                "<processor>" & processorType & "</processor>" & _
393 +              "</os>" & _
394 +              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
395 +              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
396 +              ""
397 +        Text4.Text = Text4.Text + xml
398 +
399 +        ' Use the first winsock control to send a UDP packet.
400 +        UDPSock.RemoteHost = filterHostname
401 +        UDPSock.RemotePort = filterUDPPort
402 +        UDPSock.SendData xml
403 +        Status.Caption = "UDP packet sent"
404 +        Label3.Caption = UDPUpdateTime
405 +    End If
406 +    
407 +    If Label4.Caption < 1 Then
408 +        ' establish a TCP connection to a filter
409 +        TCPSock.Close
410 +        TCPSock.Connect filterHostname, filterTCPPort
411 +        Label4.Caption = TCPUpdateTime
412 +    End If
413 +
414   End Sub
415 +
416 + Function Date2Num() As Long
417 +    Dim x As Long
418 +    x = DateDiff("s", "1-1-1970", Now)
419 +    Date2Num = x
420 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines