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

Comparing projects/cms/source/host/winhost/nettest.frm (file contents):
Revision 1.9 by pjm2, Fri Feb 23 11:30:25 2001 UTC vs.
Revision 1.24 by pjm2, Mon Feb 26 10:13:10 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"
7 <   ClientHeight    =   5655
6 >   Caption         =   "i-scream Winhost"
7 >   ClientHeight    =   1275
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
15 >   ScaleHeight     =   1275
16 >   ScaleWidth      =   4710
17     ShowInTaskbar   =   0   'False
18 <   StartUpPosition =   3  'Windows Default
19 <   Begin VB.Timer Timer1
20 <      Left            =   3840
21 <      Top             =   120
20 <   End
21 <   Begin VB.CommandButton Command3
22 <      Caption         =   "TCP to Filter"
18 >   StartUpPosition =   2  'CenterScreen
19 >   Visible         =   0   'False
20 >   Begin VB.CommandButton Hide
21 >      Caption         =   "Hide Window"
22        Height          =   375
23 <      Left            =   3720
24 <      TabIndex        =   3
25 <      Top             =   2520
26 <      Width           =   1575
23 >      Left            =   3120
24 >      TabIndex        =   6
25 >      Top             =   480
26 >      Width           =   1455
27     End
28 <   Begin VB.TextBox Text4
29 <      Height          =   1575
30 <      Left            =   240
31 <      MultiLine       =   -1  'True
32 <      ScrollBars      =   2  'Vertical
33 <      TabIndex        =   2
34 <      Text            =   "nettest.frx":0000
36 <      Top             =   3000
37 <      Width           =   5055
28 >   Begin SysTray.SystemTray SystemTray
29 >      Left            =   2160
30 >      Top             =   1800
31 >      _ExtentX        =   847
32 >      _ExtentY        =   847
33 >      SysTrayText     =   "i-scream Winhost"
34 >      IconFile        =   0
35     End
36 <   Begin VB.CommandButton Command2
37 <      Caption         =   "TCP to FilterManager"
36 >   Begin VB.Timer Timer1
37 >      Left            =   2760
38 >      Top             =   1800
39 >   End
40 >   Begin VB.CommandButton Reconfigure
41 >      Caption         =   "Reconfigure with FilterManager"
42        Height          =   375
43 <      Left            =   3360
44 <      TabIndex        =   1
45 <      Top             =   2040
46 <      Width           =   1935
43 >      Left            =   120
44 >      TabIndex        =   0
45 >      Top             =   480
46 >      Width           =   2895
47     End
48     Begin MSWinsockLib.Winsock TCPSock
49 <      Left            =   4920
50 <      Top             =   120
49 >      Left            =   3720
50 >      Top             =   1800
51        _ExtentX        =   741
52        _ExtentY        =   741
53        _Version        =   393216
54     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
55     Begin MSWinsockLib.Winsock UDPSock
56 <      Left            =   4320
57 <      Top             =   120
56 >      Left            =   3240
57 >      Top             =   1800
58        _ExtentX        =   741
59        _ExtentY        =   741
60        _Version        =   393216
# Line 71 | Line 64 | Begin VB.Form Form1
64        Alignment       =   1  'Right Justify
65        Caption         =   "Next heartbeat:"
66        Height          =   255
67 <      Left            =   120
68 <      TabIndex        =   8
69 <      Top             =   480
67 >      Left            =   2400
68 >      TabIndex        =   5
69 >      Top             =   120
70        Width           =   1455
71     End
72     Begin VB.Label Label1
# Line 81 | Line 74 | Begin VB.Form Form1
74        Caption         =   "Next UDP packet:"
75        Height          =   255
76        Left            =   120
77 <      TabIndex        =   7
77 >      TabIndex        =   4
78        Top             =   120
79        Width           =   1455
80     End
81     Begin VB.Label Label4
82 +      BorderStyle     =   1  'Fixed Single
83        Caption         =   "0"
84        Height          =   255
85 <      Left            =   1680
86 <      TabIndex        =   6
87 <      Top             =   480
85 >      Left            =   3960
86 >      TabIndex        =   3
87 >      Top             =   120
88        Width           =   615
89     End
90     Begin VB.Label Label3
91 +      BorderStyle     =   1  'Fixed Single
92        Caption         =   "0"
93        Height          =   255
94        Left            =   1680
95 <      TabIndex        =   5
95 >      TabIndex        =   2
96        Top             =   120
97        Width           =   615
98     End
99     Begin VB.Label Status
100 +      Alignment       =   2  'Center
101        Caption         =   "Status:"
102        Height          =   255
103 <      Left            =   120
104 <      TabIndex        =   4
105 <      Top             =   5280
106 <      Width           =   5415
103 >      Left            =   0
104 >      TabIndex        =   1
105 >      Top             =   960
106 >      Width           =   4695
107     End
108   End
109   Attribute VB_Name = "Form1"
# Line 115 | Line 111 | Attribute VB_GlobalNameSpace = False
111   Attribute VB_Creatable = False
112   Attribute VB_PredeclaredId = True
113   Attribute VB_Exposed = False
114 + ' For the system tray bits
115   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
116   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
117  
118   Dim filterManagerHostname As String
119 < Dim filterManagerTCPPort As Integer
119 > Dim filterManagerTCPPort As Long
120  
121 + Dim seqNo As Long
122 + Dim machineName As String
123 +
124   Dim filterHostname As String
125   Dim filterTCPPort As Integer
126   Dim filterUDPPort As Integer
# Line 132 | Line 132 | Dim TCPUpdateTime As Integer
132  
133   Dim protocolVersion As String
134   Dim connected As Boolean
135 Dim responseNumber As Integer
135  
136 + Dim CUpTime As New CUpTime
137  
138 < Private Sub Command1_Click()
138 > Dim responseNumber As Integer
139  
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
140   Private Sub Form_Load()
141 +    
142 +    If App.PrevInstance Then
143 +        x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
144 +    End If
145 +    
146      protocolVersion = "1.1"
147      
148 <    Status.Caption = "i-scream Winhost " & protocolVersion
148 >    Status.Caption = "Loading"
149 >    Form1.Caption = "i-scream Winhost " & protocolVersion
150      
151 +    CUpTime.Init
152 +    
153 +    If CUpTime.isWin9x Then
154 +        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server.")
155 +        End
156 +    End If
157 +    
158      ''''TEMP
159 <    filterManagerHostname = "killigrew.ukc.ac.uk"
160 <    filterManagerTCPPort = 4567
161 <    Exit Sub
174 <    ''' ENDTEMP
159 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
160 >    'filterManagerTCPPort = 4567
161 >    ''''' END TEMP
162      
163 +    'GoTo skip
164      On Error GoTo iniError
165      Dim buf As String * 256
166      Dim length As Long
167 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
167 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
168      filterManagerHostname = Left$(buf, length)
169 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
170 <    filterManagerTCPPort = Left$(buf, length)
169 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
170 >    filterManagerTCPPort = length
171 >    On Error GoTo 0
172 > skip:
173 >
174 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
175 >    Reconfigure_Click
176      
177 <    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
177 >    SystemTray.Icon = Val(Form1.Icon)
178 >    SystemTray.Action = 0
179      
180 +    
181      Exit Sub
182      
183   iniError:
184 <    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")
184 >    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")
185      End
186      
187   End Sub
188  
189 + Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
190 +    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")
191 +    If x = 7 Then
192 +        Cancel = True
193 +    Else
194 +        SystemTray.Action = 2
195 +    End If
196 +
197 + End Sub
198 +
199 + Private Sub Hide_Click()
200 +    Form1.Visible = False
201 +    SystemTray.Icon = Val(Form1.Icon)
202 + End Sub
203 +
204 + Private Sub Reconfigure_Click()
205 +    ' establish a TCP connection to a filtermanager
206 +    connected = False
207 +    TCPSock.Close
208 +    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
209 + End Sub
210 +
211 +
212 +
213 + Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
214 +
215 +    Form1.Visible = True
216 +    Form1.SetFocus
217 +
218 + End Sub
219 +
220   Private Sub TCPSock_Connect()
221      
222      responseNumber = 0
# Line 216 | Line 242 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
242      ' Remove linefeeds and returns from the line.
243      response = Replace(response, Chr(13), "")
244      response = Replace(response, Chr(10), "")
245 <    Text4.Text = Text4.Text & vbCrLf & response
245 >    'Text4.Text = Text4.Text & vbCrLf & response
246      
247      If connected = False Then
248          ' Perform TCP configuration (1.1)
# Line 263 | Line 289 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
289                  connected = True
290                  responseNumber = 0
291                  TCPSock.Close
292 <                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
293 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
292 >                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
293 >                Status.Caption = "Configuration successful"
294                  Label3.Caption = UDPUpdateTime
295                  Label4.Caption = TCPUpdateTime
296                  Timer1.Interval = 1000
# Line 288 | Line 314 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
314              Case 5:
315                  If Not response = "OK" Then GoTo heartbeatError
316                  TCPSock.Close
317 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
317 >                Status.Caption = "Heartbeat sent successfully."
318          End Select
319      
320      End If
# Line 297 | Line 323 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
323      Exit Sub
324      
325   configError:
326 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
326 >    Status.Caption = "FAILED to get configuration"
327      Exit Sub
328   heartbeatError:
329 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
329 >    Status.Caption = "Heatbeat FAILED"
330      Exit Sub
331   End Sub
332  
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
333   Private Sub Timer1_Timer()
334  
335      Label3.Caption = Label3.Caption - 1
336      Label4.Caption = Label4.Caption - 1
337      
338 <    Status.Caption = "i-scream Winhost " & protocolVersion
338 >    Status.Caption = ""
339      
340      If Label3.Caption < 1 Then
341 <        ' build the contents of the XML packet.
342 <        xml = "<packet></packet>"
341 >        
342 >        ' prepare the contents of the XML packet.
343 >        seqNo = seqNo + 1
344 >        machineName = TCPSock.LocalHostName
345 >        LocalIP = TCPSock.LocalIP
346 >        packetDate = Date2Num()
347 >        
348 >        
349 >        Dim verinfo As OSVERSIONINFO
350 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
351 >        ret% = GetVersionEx(verinfo)
352 >        If ret% = 0 Then
353 >            MsgBox "Error getting Windows version Information"
354 >            End
355 >        End If
356 >          
357 >        osName = GetVersion()
358 >        osVersionMajor = verinfo.dwMajorVersion
359 >        osVersionMinor = verinfo.dwMinorVersion
360 >        osBuild = verinfo.dwBuildNumber
361 >        
362 >        Dim sysinfo As SYSTEM_INFO
363 >        GetSystemInfo sysinfo
364 >        Select Case sysinfo.dwProcessorType
365 >            Case PROCESSOR_INTEL_386
366 >                processorType = "Intel 386"
367 >            Case PROCESSOR_INTEL_486
368 >                processorType = "Intel 486"
369 >            Case PROCESSOR_INTEL_PENTIUM
370 >                processorType = "Intel Pentium variant"
371 >            Case PROCESSOR_MIPS_R4000
372 >                processorType = "MIPS R4000"
373 >            Case PROCESSOR_ALPHA_21064
374 >                processorType = "DEC Alpha 21064"
375 >            Case Else
376 >                processorType = "(unknown)"
377 >        End Select
378 >        
379 >        Dim memsts As MEMORYSTATUS
380 >        Dim memory&
381 >        GlobalMemoryStatus memsts
382 >        memory& = memsts.dwTotalPhys
383 >        memTotal = memory& \ 1024
384 >        memory& = memsts.dwAvailPhys
385 >        memFree = memory& \ 1024
386 >        memory& = memsts.dwTotalVirtual
387 >        swapTotal = memory& \ 1024
388 >        memory& = memsts.dwAvailVirtual
389 >        swapFree = memory& \ 1024
390 >        
391 >        uptime = GetTickCount \ 1000
392 >        
393 >        CUpTime.Capture
394 >        cpu_time = CUpTime.CPUTime
395 >        percent_idle = CUpTime.PercentIdle
396 >        
397 >        ' build the contents of the XML packet
398 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
399 >              "<os>" & _
400 >                "<name>" & osName & "</name>" & _
401 >                "<version>" & osVersionMajor & "</version>" & _
402 >                "<release>" & osBuild & "</release>" & _
403 >                "<platform>" & osName & "</platform>" & _
404 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
405 >                "<processor>" & processorType & "</processor>" & _
406 >                "<uptime>" & uptime & "</uptime>" & _
407 >              "</os>" & _
408 >              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
409 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
410 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
411 >              "</packet>"
412 >        'Text4.Text = Text4.Text + xml
413  
414          ' Use the first winsock control to send a UDP packet.
415          UDPSock.RemoteHost = filterHostname
416          UDPSock.RemotePort = filterUDPPort
417          UDPSock.SendData xml
418 <        Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
418 >        Status.Caption = "UDP packet sent"
419          Label3.Caption = UDPUpdateTime
420      End If
421      
# Line 352 | Line 427 | Private Sub Timer1_Timer()
427      End If
428  
429   End Sub
430 +
431 + Function Date2Num() As Long
432 +    Dim x As Long
433 +    x = DateDiff("s", "1-1-1970", Now)
434 +    Date2Num = x
435 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines