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.18 by pjm2, Fri Feb 23 17:51:07 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"
6 >   Caption         =   "i-scream Winhost"
7     ClientHeight    =   5655
8     ClientLeft      =   45
9     ClientTop       =   330
10 <   ClientWidth     =   5670
10 >   ClientWidth     =   4710
11     LinkTopic       =   "Form1"
12     MaxButton       =   0   'False
13     MinButton       =   0   'False
14     ScaleHeight     =   5655
15 <   ScaleWidth      =   5670
15 >   ScaleWidth      =   4710
16     ShowInTaskbar   =   0   'False
17     StartUpPosition =   3  'Windows Default
18 <   Begin VB.CommandButton Command3
19 <      Caption         =   "TCP to Filter"
18 >   Begin VB.CommandButton Hide
19 >      Caption         =   "Hide Window"
20        Height          =   375
21 <      Left            =   3720
22 <      TabIndex        =   5
23 <      Top             =   2520
24 <      Width           =   1575
21 >      Left            =   3120
22 >      TabIndex        =   7
23 >      Top             =   840
24 >      Width           =   1455
25     End
26 +   Begin SysTray.SystemTray SystemTray
27 +      Left            =   2160
28 +      Top             =   1800
29 +      _ExtentX        =   847
30 +      _ExtentY        =   847
31 +      SysTrayText     =   "i-scream Winhost"
32 +      IconFile        =   0
33 +   End
34 +   Begin VB.Timer Timer1
35 +      Left            =   2760
36 +      Top             =   1800
37 +   End
38     Begin VB.TextBox Text4
39 <      Height          =   2535
39 >      Height          =   1575
40        Left            =   240
41        MultiLine       =   -1  'True
42        ScrollBars      =   2  'Vertical
43 <      TabIndex        =   4
43 >      TabIndex        =   1
44        Text            =   "nettest.frx":0000
45        Top             =   3000
46 <      Width           =   5055
46 >      Width           =   3975
47     End
48 <   Begin VB.CommandButton Command2
49 <      Caption         =   "TCP to FilterManager"
48 >   Begin VB.CommandButton Reconfigure
49 >      Caption         =   "Reconfigure with FilterManager"
50        Height          =   375
51 <      Left            =   3360
52 <      TabIndex        =   3
53 <      Top             =   2040
54 <      Width           =   1935
51 >      Left            =   120
52 >      TabIndex        =   0
53 >      Top             =   840
54 >      Width           =   2895
55     End
56 <   Begin MSWinsockLib.Winsock Winsock2
57 <      Left            =   4920
58 <      Top             =   120
56 >   Begin MSWinsockLib.Winsock TCPSock
57 >      Left            =   3720
58 >      Top             =   1800
59        _ExtentX        =   741
60        _ExtentY        =   741
61        _Version        =   393216
62     End
63 <   Begin VB.CommandButton Command1
64 <      Caption         =   "Send UDP"
65 <      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
63 >   Begin MSWinsockLib.Winsock UDPSock
64 >      Left            =   3240
65 >      Top             =   1800
66        _ExtentX        =   741
67        _ExtentY        =   741
68        _Version        =   393216
69        Protocol        =   1
70     End
71 +   Begin VB.Label Label5
72 +      Caption         =   "b e t a"
73 +      BeginProperty Font
74 +         Name            =   "MS Sans Serif"
75 +         Size            =   24
76 +         Charset         =   0
77 +         Weight          =   700
78 +         Underline       =   0   'False
79 +         Italic          =   0   'False
80 +         Strikethrough   =   0   'False
81 +      EndProperty
82 +      Height          =   615
83 +      Left            =   240
84 +      TabIndex        =   8
85 +      Top             =   120
86 +      Width           =   1815
87 +   End
88 +   Begin VB.Label Label2
89 +      Alignment       =   1  'Right Justify
90 +      Caption         =   "Next heartbeat:"
91 +      Height          =   255
92 +      Left            =   2400
93 +      TabIndex        =   6
94 +      Top             =   480
95 +      Width           =   1455
96 +   End
97     Begin VB.Label Label1
98 <      Caption         =   "Packet contents"
98 >      Alignment       =   1  'Right Justify
99 >      Caption         =   "Next UDP packet:"
100        Height          =   255
101 <      Left            =   360
102 <      TabIndex        =   1
103 <      Top             =   360
104 <      Width           =   2895
101 >      Left            =   2400
102 >      TabIndex        =   5
103 >      Top             =   120
104 >      Width           =   1455
105     End
106 +   Begin VB.Label Label4
107 +      BorderStyle     =   1  'Fixed Single
108 +      Caption         =   "0"
109 +      Height          =   255
110 +      Left            =   3960
111 +      TabIndex        =   4
112 +      Top             =   480
113 +      Width           =   615
114 +   End
115 +   Begin VB.Label Label3
116 +      BorderStyle     =   1  'Fixed Single
117 +      Caption         =   "0"
118 +      Height          =   255
119 +      Left            =   3960
120 +      TabIndex        =   3
121 +      Top             =   120
122 +      Width           =   615
123 +   End
124 +   Begin VB.Label Status
125 +      Alignment       =   2  'Center
126 +      Caption         =   "Status:"
127 +      Height          =   255
128 +      Left            =   0
129 +      TabIndex        =   2
130 +      Top             =   1320
131 +      Width           =   4695
132 +   End
133   End
134   Attribute VB_Name = "Form1"
135   Attribute VB_GlobalNameSpace = False
136   Attribute VB_Creatable = False
137   Attribute VB_PredeclaredId = True
138   Attribute VB_Exposed = False
139 + ' For the system tray bits
140   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
141   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
142  
143   Dim filterManagerHostname As String
144 < Dim filterManagerTCPPort As Integer
144 > Dim filterManagerTCPPort As Long
145  
146 + Dim seqNo As Long
147 + Dim machineName As String
148 +
149   Dim filterHostname As String
150   Dim filterTCPPort As Integer
151   Dim filterUDPPort As Integer
152   Dim fileList As String
153   Dim lastModified As String
154  
155 + Dim UDPUpdateTime As Integer
156 + Dim TCPUpdateTime As Integer
157 +
158   Dim protocolVersion As String
159   Dim connected As Boolean
102 Dim responseNumber As Integer
160  
161 + 'Dim CUpTime As New CUpTime
162  
163 < Private Sub Command1_Click()
163 > Dim responseNumber As Integer
164  
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
165   Private Sub Form_Load()
166 +    
167      protocolVersion = "1.1"
168      
169 +    Status.Caption = "Loading"
170 +    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
171 +    
172      ''''TEMP
173 <    filterManagerHostname = "killigrew.ukc.ac.uk"
174 <    filterManagerTCPPort = 4567
175 <    Exit Sub
137 <    ''' ENDTEMP
173 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
174 >    'filterManagerTCPPort = 4567
175 >    ''''' END TEMP
176      
177 +    'GoTo skip
178      On Error GoTo iniError
179      Dim buf As String * 256
180      Dim length As Long
181 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
181 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
182      filterManagerHostname = Left$(buf, length)
183 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
184 <    filterManagerTCPPort = Left$(buf, length)
183 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
184 >    filterManagerTCPPort = length
185 > skip:
186 >
187 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
188 >    Reconfigure_Click
189      
190 +    Form1.Show
191 +    SystemTray.Action = 0
192 +    
193 +    
194      Exit Sub
195      
196   iniError:
197 <    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")
197 >    x = MsgBox("The i-scream Winhost could not read the correct settings from the winhost.ini file.  Please correct these and try again.  " & Err.Description, 48, "Configuration not found")
198      End
199      
200   End Sub
201  
202 < Private Sub Label2_Click()
202 > Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
203 >    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")
204 >    If x = 7 Then
205 >        Cancel = True
206 >    Else
207 >        SystemTray.Action = 2
208 >    End If
209  
210   End Sub
211  
212 < Private Sub Winsock2_Connect()
213 <      
214 <   responseNumber = 0
212 > Private Sub Hide_Click()
213 >    Form1.Visible = False
214 >    SystemTray.Icon = Val(Form1.Icon)
215 > End Sub
216 >
217 > Private Sub Reconfigure_Click()
218 >    ' establish a TCP connection to a filtermanager
219 >    connected = False
220 >    TCPSock.Close
221 >    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
222 > End Sub
223 >
224 >
225 >
226 > Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
227 >
228 >    Form1.Visible = True
229 >    Form1.SetFocus
230 >    
231 >
232 > End Sub
233 >
234 > Private Sub TCPSock_Connect()
235 >    
236 >    responseNumber = 0
237    
238      ' Send something as soon as we connect to the server.
239      If connected = False Then
240          ' contact the FilterManager
241 <        Winsock2.SendData "STARTCONFIG" & vbCrLf
241 >        TCPSock.SendData "STARTCONFIG" & vbCrLf
242      Else
243         ' Contact the Filter
244 <       Winsock2.SendData "HEARTBEAT" & vbCrLf
244 >       TCPSock.SendData "HEARTBEAT" & vbCrLf
245      End If
246    
247   End Sub
248  
249 < Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
249 > Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
250      
251      responseNumber = responseNumber + 1
252      
253      ' Get the line from the server.
254 <    Winsock2.GetData response, vbString, bytesTotal
254 >    TCPSock.GetData response, vbString, bytesTotal
255      
256      ' Remove linefeeds and returns from the line.
257      response = Replace(response, Chr(13), "")
# Line 189 | Line 264 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
264          Select Case responseNumber
265              Case 1:
266                  If Not response = "OK" Then GoTo configError
267 <                Winsock2.SendData "LASTMODIFIED" & vbCrLf
267 >                TCPSock.SendData "LASTMODIFIED" & vbCrLf
268              Case 2:
269                  If response = "ERROR" Then GoTo configError
270                  lastModified = response
271 <                Winsock2.SendData "FILELIST" & vbCrLf
271 >                TCPSock.SendData "FILELIST" & vbCrLf
272              Case 3:
273                  If response = "ERROR" Then GoTo configError
274                  fileList = response
275 <                Winsock2.SendData "UDPUpdateTime" & vbCrLf
275 >                TCPSock.SendData "UDPUpdateTime" & vbCrLf
276              Case 4:
277                  If response = "ERROR" Then GoTo configError
278 <                Winsock2.SendData "TCPUpdateTime" & vbCrLf
278 >                UDPUpdateTime = response
279 >                TCPSock.SendData "TCPUpdateTime" & vbCrLf
280              Case 5:
281                  If response = "ERROR" Then GoTo configError
282 <                Winsock2.SendData "ENDCONFIG" & vbCrLf
282 >                TCPUpdateTime = response
283 >                TCPSock.SendData "ENDCONFIG" & vbCrLf
284              Case 6:
285                  If Not response = "OK" Then GoTo configError
286 <                Winsock2.SendData "FILTER" & vbCrLf
286 >                TCPSock.SendData "FILTER" & vbCrLf
287              Case 7:
288                  'we got a filter list here.
289                  readTo = 0
# Line 220 | Line 297 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
297                  response = Mid(response, readTo + 1, Len(response))
298                  ' get TCP Port number
299                  filterTCPPort = response
300 <                Winsock2.SendData "END" & vbCrLf
300 >                TCPSock.SendData "END" & vbCrLf
301              Case 8:
302                  If Not response = "OK" Then GoTo configError
303                  connected = True
304                  responseNumber = 0
305 <                Winsock2.Close
305 >                TCPSock.Close
306                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
307 <                x = MsgBox("got config okay")
307 >                Status.Caption = "Configuration successful"
308 >                Label3.Caption = UDPUpdateTime
309 >                Label4.Caption = TCPUpdateTime
310 >                Timer1.Interval = 1000
311          End Select
312      Else
313          ' Perform a heartbeat (1.1)
# Line 235 | Line 315 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
315          Select Case responseNumber
316              Case 1:
317                  If Not response = "OK" Then GoTo heartbeatError
318 <                Winsock2.SendData "CONFIG" & vbCrLf
318 >                TCPSock.SendData "CONFIG" & vbCrLf
319              Case 2:
320                  If Not response = "OK" Then GoTo heartbeatError
321 <                Winsock2.SendData fileList & vbCrLf
321 >                TCPSock.SendData fileList & vbCrLf
322              Case 3:
323                  If Not response = "OK" Then GoTo heartbeatError
324 <                Winsock2.SendData lastModified & vbCrLf
324 >                TCPSock.SendData lastModified & vbCrLf
325              Case 4:
326                  If Not response = "OK" Then GoTo heartbeatError
327 <                Winsock2.SendData "ENDHEARTBEAT" & vbCrLf
327 >                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
328              Case 5:
329                  If Not response = "OK" Then GoTo heartbeatError
330 <                Winsock2.Close
331 <                x = MsgBox("heartbeat sent okay.")
330 >                TCPSock.Close
331 >                Status.Caption = "Heartbeat sent successfully."
332          End Select
333      
334      End If
# Line 257 | Line 337 | Private Sub Winsock2_DataArrival(ByVal bytesTotal As L
337      Exit Sub
338      
339   configError:
340 <    x = MsgBox("error doing configuration")
340 >    Status.Caption = "FAILED to get configuration"
341 >    Exit Sub
342   heartbeatError:
343 <    x = MsgBox("error doing configuration")
343 >    Status.Caption = "Heatbeat FAILED"
344 >    Exit Sub
345   End Sub
346 +
347 + Private Sub Timer1_Timer()
348 +
349 +    Label3.Caption = Label3.Caption - 1
350 +    Label4.Caption = Label4.Caption - 1
351 +    
352 +    Status.Caption = ""
353 +    
354 +    If Label3.Caption < 1 Then
355 +        
356 +        ' prepare the contents of the XML packet.
357 +        seqNo = seqNo + 1
358 +        machineName = TCPSock.LocalHostName
359 +        LocalIP = TCPSock.LocalIP
360 +        packetDate = Date2Num()
361 +        
362 +        
363 +        Dim verinfo As OSVERSIONINFO
364 +        verinfo.dwOSVersionInfoSize = Len(verinfo)
365 +        ret% = GetVersionEx(verinfo)
366 +        If ret% = 0 Then
367 +            MsgBox "Error getting Windows version Information"
368 +            End
369 +        End If
370 +          
371 +        osName = getVersion()
372 +        osVersionMajor = verinfo.dwMajorVersion
373 +        osVersionMinor = verinfo.dwMinorVersion
374 +        osBuild = verinfo.dwBuildNumber
375 +        
376 +        Dim sysinfo As SYSTEM_INFO
377 +        GetSystemInfo sysinfo
378 +        Select Case sysinfo.dwProcessorType
379 +            Case PROCESSOR_INTEL_386
380 +                processorType = "Intel 386"
381 +            Case PROCESSOR_INTEL_486
382 +                processorType = "Intel 486"
383 +            Case PROCESSOR_INTEL_PENTIUM
384 +                processorType = "Intel Pentium variant"
385 +            Case PROCESSOR_MIPS_R4000
386 +                processorType = "MIPS R4000"
387 +            Case PROCESSOR_ALPHA_21064
388 +                processorType = "DEC Alpha 21064"
389 +            Case Else
390 +                processorType = "(unknown)"
391 +        End Select
392 +        
393 +        Dim memsts As MEMORYSTATUS
394 +        Dim memory&
395 +        GlobalMemoryStatus memsts
396 +        memory& = memsts.dwTotalPhys
397 +        memTotal = memory& \ 1024
398 +        memory& = memsts.dwAvailPhys
399 +        memFree = memory& \ 1024
400 +        memory& = memsts.dwTotalVirtual
401 +        swapTotal = memory& \ 1024
402 +        memory& = memsts.dwAvailVirtual
403 +        swapFree = memory& \ 1024
404 +        
405 +        ' build the contents of the XML packet
406 +        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
407 +              "<os>" & _
408 +                "<name>" & osName & "</name>" & _
409 +                "<version>" & osVersionMajor & "</version>" & _
410 +                "<release>" & osBuild & "</release>" & _
411 +                "<platform>" & osName & "</platform>" & _
412 +                "<minor_version>" & osVersionMinor & "</minor_version>" & _
413 +                "<processor>" & processorType & "</processor>" & _
414 +              "</os>" & _
415 +              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
416 +              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
417 +              "</packet>"
418 +        Text4.Text = Text4.Text + xml
419 +
420 +        ' Use the first winsock control to send a UDP packet.
421 +        UDPSock.RemoteHost = filterHostname
422 +        UDPSock.RemotePort = filterUDPPort
423 +        UDPSock.SendData xml
424 +        Status.Caption = "UDP packet sent"
425 +        Label3.Caption = UDPUpdateTime
426 +    End If
427 +    
428 +    If Label4.Caption < 1 Then
429 +        ' establish a TCP connection to a filter
430 +        TCPSock.Close
431 +        TCPSock.Connect filterHostname, filterTCPPort
432 +        Label4.Caption = TCPUpdateTime
433 +    End If
434 +
435 + End Sub
436 +
437 + Function Date2Num() As Long
438 +    Dim x As Long
439 +    x = DateDiff("s", "1-1-1970", Now)
440 +    Date2Num = x
441 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines