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.9 by pjm2, Fri Feb 23 11:30:25 2001 UTC vs.
Revision 1.20 by pjm2, Mon Feb 26 09:12:51 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.Timer Timer1
20 <      Left            =   3840
19 <      Top             =   120
20 <   End
21 <   Begin VB.CommandButton Command3
22 <      Caption         =   "TCP to Filter"
19 >   Begin VB.CommandButton Hide
20 >      Caption         =   "Hide Window"
21        Height          =   375
22 <      Left            =   3720
23 <      TabIndex        =   3
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          =   1575
41        Left            =   240
42        MultiLine       =   -1  'True
43        ScrollBars      =   2  'Vertical
44 <      TabIndex        =   2
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        =   1
54 <      Top             =   2040
55 <      Width           =   1935
52 >      Left            =   120
53 >      TabIndex        =   0
54 >      Top             =   840
55 >      Width           =   2895
56     End
57     Begin MSWinsockLib.Winsock TCPSock
58 <      Left            =   4920
59 <      Top             =   120
58 >      Left            =   3720
59 >      Top             =   1800
60        _ExtentX        =   741
61        _ExtentY        =   741
62        _Version        =   393216
63     End
54   Begin VB.CommandButton Command1
55      Caption         =   "Send UDP"
56      Height          =   375
57      Left            =   4320
58      TabIndex        =   0
59      Top             =   1560
60      Width           =   975
61   End
64     Begin MSWinsockLib.Winsock UDPSock
65 <      Left            =   4320
66 <      Top             =   120
65 >      Left            =   3240
66 >      Top             =   1800
67        _ExtentX        =   741
68        _ExtentY        =   741
69        _Version        =   393216
70        Protocol        =   1
71     End
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         =   "Next heartbeat:"
92        Height          =   255
93 <      Left            =   120
94 <      TabIndex        =   8
93 >      Left            =   2400
94 >      TabIndex        =   6
95        Top             =   480
96        Width           =   1455
97     End
# Line 80 | Line 99 | Begin VB.Form Form1
99        Alignment       =   1  'Right Justify
100        Caption         =   "Next UDP packet:"
101        Height          =   255
102 <      Left            =   120
103 <      TabIndex        =   7
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            =   1680
112 <      TabIndex        =   6
111 >      Left            =   3960
112 >      TabIndex        =   4
113        Top             =   480
114        Width           =   615
115     End
116     Begin VB.Label Label3
117 +      BorderStyle     =   1  'Fixed Single
118        Caption         =   "0"
119        Height          =   255
120 <      Left            =   1680
121 <      TabIndex        =   5
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            =   120
130 <      TabIndex        =   4
131 <      Top             =   5280
132 <      Width           =   5415
129 >      Left            =   0
130 >      TabIndex        =   2
131 >      Top             =   1320
132 >      Width           =   4695
133     End
134   End
135   Attribute VB_Name = "Form1"
# Line 115 | Line 137 | 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 Integer
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
# Line 132 | Line 158 | Dim TCPUpdateTime As Integer
158  
159   Dim protocolVersion As String
160   Dim connected As Boolean
135 Dim responseNumber As Integer
161  
162 + 'Dim CUpTime As New CUpTime
163  
164 < Private Sub Command1_Click()
164 > Dim responseNumber As Integer
165  
140    ' build the contents of the XML packet.
141    xml = "<packet></packet>"
142
143    ' Use the first winsock control to send a UDP packet.
144    UDPSock.RemoteHost = filterHostname
145    UDPSock.RemotePort = filterUDPPort
146    UDPSock.SendData xml
147    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
148
149 End Sub
150
151 Private Sub Command2_Click()
152    
153    ' establish a TCP connection to a filtermanager
154    TCPSock.Close
155    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
156
157 End Sub
158
159 Private Sub Command3_Click()
160    ' establish a TCP connection to a filter
161    TCPSock.Close
162    TCPSock.Connect filterHostname, filterTCPPort
163 End Sub
164
166   Private Sub Form_Load()
167 +    
168      protocolVersion = "1.1"
169      
170 <    Status.Caption = "i-scream Winhost " & protocolVersion
170 >    Status.Caption = "Loading"
171 >    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
172      
173      ''''TEMP
174 <    filterManagerHostname = "killigrew.ukc.ac.uk"
175 <    filterManagerTCPPort = 4567
176 <    Exit Sub
174 <    ''' ENDTEMP
174 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
175 >    'filterManagerTCPPort = 4567
176 >    ''''' END TEMP
177      
178 +    'GoTo skip
179      On Error GoTo iniError
180      Dim buf As String * 256
181      Dim length As Long
182 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
182 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
183      filterManagerHostname = Left$(buf, length)
184 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
185 <    filterManagerTCPPort = Left$(buf, length)
184 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
185 >    filterManagerTCPPort = length
186 >    On Error GoTo 0
187 > skip:
188 >
189 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
190 >    Reconfigure_Click
191      
192 <    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
192 >    SystemTray.Icon = Val(Form1.Icon)
193 >    SystemTray.Action = 0
194      
195 +    
196      Exit Sub
197      
198   iniError:
199 <    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")
199 >    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")
200      End
201      
202   End Sub
203  
204 + Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
205 +    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")
206 +    If x = 7 Then
207 +        Cancel = True
208 +    Else
209 +        SystemTray.Action = 2
210 +    End If
211 +
212 + End Sub
213 +
214 + Private Sub Hide_Click()
215 +    Form1.Visible = False
216 +    SystemTray.Icon = Val(Form1.Icon)
217 + End Sub
218 +
219 + Private Sub Reconfigure_Click()
220 +    ' establish a TCP connection to a filtermanager
221 +    connected = False
222 +    TCPSock.Close
223 +    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
224 + End Sub
225 +
226 +
227 +
228 + Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
229 +
230 +    Form1.Visible = True
231 +    Form1.SetFocus
232 +    
233 +
234 + End Sub
235 +
236   Private Sub TCPSock_Connect()
237      
238      responseNumber = 0
# Line 264 | Line 306 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
306                  responseNumber = 0
307                  TCPSock.Close
308                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
309 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
309 >                Status.Caption = "Configuration successful"
310                  Label3.Caption = UDPUpdateTime
311                  Label4.Caption = TCPUpdateTime
312                  Timer1.Interval = 1000
# Line 288 | Line 330 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
330              Case 5:
331                  If Not response = "OK" Then GoTo heartbeatError
332                  TCPSock.Close
333 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
333 >                Status.Caption = "Heartbeat sent successfully."
334          End Select
335      
336      End If
# Line 297 | Line 339 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
339      Exit Sub
340      
341   configError:
342 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
342 >    Status.Caption = "FAILED to get configuration"
343      Exit Sub
344   heartbeatError:
345 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
345 >    Status.Caption = "Heatbeat FAILED"
346      Exit Sub
347   End Sub
348  
307 Private Sub TCPTimer_Timer()
308    
309    ' establish a TCP connection to a filter
310    TCPSock.Close
311    TCPSock.Connect filterHostname, filterTCPPort
312
313 End Sub
314
315 Private Sub UDPTimer_Timer()
316    
317    ' build the contents of the XML packet.
318    xml = "<packet></packet>"
319
320    ' Use the first winsock control to send a UDP packet.
321    UDPSock.RemoteHost = filterHostname
322    UDPSock.RemotePort = filterUDPPort
323    UDPSock.SendData xml
324    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
325
326 End Sub
327
349   Private Sub Timer1_Timer()
350  
351      Label3.Caption = Label3.Caption - 1
352      Label4.Caption = Label4.Caption - 1
353      
354 <    Status.Caption = "i-scream Winhost " & protocolVersion
354 >    Status.Caption = ""
355      
356      If Label3.Caption < 1 Then
357 <        ' build the contents of the XML packet.
358 <        xml = "<packet></packet>"
357 >        
358 >        ' prepare the contents of the XML packet.
359 >        seqNo = seqNo + 1
360 >        machineName = TCPSock.LocalHostName
361 >        LocalIP = TCPSock.LocalIP
362 >        packetDate = Date2Num()
363 >        
364 >        
365 >        Dim verinfo As OSVERSIONINFO
366 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
367 >        ret% = GetVersionEx(verinfo)
368 >        If ret% = 0 Then
369 >            MsgBox "Error getting Windows version Information"
370 >            End
371 >        End If
372 >          
373 >        osName = getVersion()
374 >        osVersionMajor = verinfo.dwMajorVersion
375 >        osVersionMinor = verinfo.dwMinorVersion
376 >        osBuild = verinfo.dwBuildNumber
377 >        
378 >        Dim sysinfo As SYSTEM_INFO
379 >        GetSystemInfo sysinfo
380 >        Select Case sysinfo.dwProcessorType
381 >            Case PROCESSOR_INTEL_386
382 >                processorType = "Intel 386"
383 >            Case PROCESSOR_INTEL_486
384 >                processorType = "Intel 486"
385 >            Case PROCESSOR_INTEL_PENTIUM
386 >                processorType = "Intel Pentium variant"
387 >            Case PROCESSOR_MIPS_R4000
388 >                processorType = "MIPS R4000"
389 >            Case PROCESSOR_ALPHA_21064
390 >                processorType = "DEC Alpha 21064"
391 >            Case Else
392 >                processorType = "(unknown)"
393 >        End Select
394 >        
395 >        Dim memsts As MEMORYSTATUS
396 >        Dim memory&
397 >        GlobalMemoryStatus memsts
398 >        memory& = memsts.dwTotalPhys
399 >        memTotal = memory& \ 1024
400 >        memory& = memsts.dwAvailPhys
401 >        memFree = memory& \ 1024
402 >        memory& = memsts.dwTotalVirtual
403 >        swapTotal = memory& \ 1024
404 >        memory& = memsts.dwAvailVirtual
405 >        swapFree = memory& \ 1024
406 >        
407 >        uptime = GetTickCount \ 1000
408 >        
409 >        ' build the contents of the XML packet
410 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
411 >              "<os>" & _
412 >                "<name>" & osName & "</name>" & _
413 >                "<version>" & osVersionMajor & "</version>" & _
414 >                "<release>" & osBuild & "</release>" & _
415 >                "<platform>" & osName & "</platform>" & _
416 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
417 >                "<processor>" & processorType & "</processor>" & _
418 >                "<uptime>" & uptime & "</uptime>" & _
419 >              "</os>" & _
420 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
421 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
422 >              "</packet>"
423 >        Text4.Text = Text4.Text + xml
424  
425          ' Use the first winsock control to send a UDP packet.
426          UDPSock.RemoteHost = filterHostname
427          UDPSock.RemotePort = filterUDPPort
428          UDPSock.SendData xml
429 <        Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
429 >        Status.Caption = "UDP packet sent"
430          Label3.Caption = UDPUpdateTime
431      End If
432      
# Line 352 | Line 438 | Private Sub Timer1_Timer()
438      End If
439  
440   End Sub
441 +
442 + Function Date2Num() As Long
443 +    Dim x As Long
444 +    x = DateDiff("s", "1-1-1970", Now)
445 +    Date2Num = x
446 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines