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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines