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.11 by pjm2, Fri Feb 23 11:56:43 2001 UTC vs.
Revision 1.26 by pjm2, Wed Feb 28 09:08:08 2001 UTC

# Line 2 | Line 2 | 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     =   4  'Fixed ToolWindow
5 >   BorderStyle     =   3  'Fixed Dialog
6     Caption         =   "i-scream Winhost"
7 <   ClientHeight    =   5655
7 >   ClientHeight    =   4905
8     ClientLeft      =   45
9 <   ClientTop       =   285
10 <   ClientWidth     =   5670
9 >   ClientTop       =   330
10 >   ClientWidth     =   4710
11 >   Icon            =   "nettest.frx":0000
12     LinkTopic       =   "Form1"
13     MaxButton       =   0   'False
14 <   ScaleHeight     =   5655
15 <   ScaleWidth      =   5670
14 >   MinButton       =   0   'False
15 >   ScaleHeight     =   4905
16 >   ScaleWidth      =   4710
17     ShowInTaskbar   =   0   'False
18 <   StartUpPosition =   3  'Windows Default
19 <   Begin VB.CommandButton Hide
20 <      Caption         =   "Hide"
21 <      Height          =   495
22 <      Left            =   1800
18 >   StartUpPosition =   2  'CenterScreen
19 >   Visible         =   0   'False
20 >   Begin VB.CommandButton Command1
21 >      Caption         =   "more"
22 >      Height          =   255
23 >      Left            =   3960
24 >      TabIndex        =   8
25 >      Top             =   840
26 >      Width           =   615
27 >   End
28 >   Begin VB.TextBox Text1
29 >      Height          =   2055
30 >      Left            =   120
31 >      Locked          =   -1  'True
32 >      MultiLine       =   -1  'True
33 >      ScrollBars      =   2  'Vertical
34        TabIndex        =   7
35 <      Top             =   2160
36 <      Width           =   1215
35 >      Top             =   1200
36 >      Width           =   4455
37     End
38 +   Begin VB.CommandButton Hide
39 +      Caption         =   "Hide Window"
40 +      Height          =   375
41 +      Left            =   3120
42 +      TabIndex        =   6
43 +      Top             =   240
44 +      Width           =   1455
45 +   End
46     Begin SysTray.SystemTray SystemTray
47 <      Left            =   3600
48 <      Top             =   1200
47 >      Left            =   2520
48 >      Top             =   4200
49        _ExtentX        =   847
50        _ExtentY        =   847
51        SysTrayText     =   "i-scream Winhost"
52        IconFile        =   0
53     End
54     Begin VB.Timer Timer1
55 <      Left            =   4200
56 <      Top             =   1200
55 >      Left            =   3120
56 >      Top             =   4200
57     End
37   Begin VB.TextBox Text4
38      Height          =   1575
39      Left            =   240
40      MultiLine       =   -1  'True
41      ScrollBars      =   2  'Vertical
42      TabIndex        =   1
43      Text            =   "nettest.frx":0000
44      Top             =   3000
45      Width           =   5055
46   End
58     Begin VB.CommandButton Reconfigure
59        Caption         =   "Reconfigure with FilterManager"
60 <      Height          =   495
61 <      Left            =   120
60 >      Height          =   375
61 >      Left            =   840
62        TabIndex        =   0
63 <      Top             =   120
63 >      Top             =   3480
64        Width           =   2895
65     End
66     Begin MSWinsockLib.Winsock TCPSock
67 <      Left            =   5160
68 <      Top             =   1200
67 >      Left            =   4080
68 >      Top             =   4200
69        _ExtentX        =   741
70        _ExtentY        =   741
71        _Version        =   393216
72     End
73     Begin MSWinsockLib.Winsock UDPSock
74 <      Left            =   4680
75 <      Top             =   1200
74 >      Left            =   3600
75 >      Top             =   4200
76        _ExtentX        =   741
77        _ExtentY        =   741
78        _Version        =   393216
# Line 71 | Line 82 | Begin VB.Form Form1
82        Alignment       =   1  'Right Justify
83        Caption         =   "Next heartbeat:"
84        Height          =   255
85 <      Left            =   3360
86 <      TabIndex        =   6
85 >      Left            =   120
86 >      TabIndex        =   5
87        Top             =   480
88        Width           =   1455
89     End
# Line 80 | Line 91 | Begin VB.Form Form1
91        Alignment       =   1  'Right Justify
92        Caption         =   "Next UDP packet:"
93        Height          =   255
94 <      Left            =   3360
95 <      TabIndex        =   5
94 >      Left            =   120
95 >      TabIndex        =   4
96        Top             =   120
97        Width           =   1455
98     End
# Line 89 | Line 100 | Begin VB.Form Form1
100        BorderStyle     =   1  'Fixed Single
101        Caption         =   "0"
102        Height          =   255
103 <      Left            =   4920
104 <      TabIndex        =   4
103 >      Left            =   1680
104 >      TabIndex        =   3
105        Top             =   480
106        Width           =   615
107     End
# Line 98 | Line 109 | Begin VB.Form Form1
109        BorderStyle     =   1  'Fixed Single
110        Caption         =   "0"
111        Height          =   255
112 <      Left            =   4920
113 <      TabIndex        =   3
112 >      Left            =   1680
113 >      TabIndex        =   2
114        Top             =   120
115        Width           =   615
116     End
117     Begin VB.Label Status
118 +      Alignment       =   2  'Center
119        Caption         =   "Status:"
120        Height          =   255
121 <      Left            =   120
122 <      TabIndex        =   2
121 >      Left            =   0
122 >      TabIndex        =   1
123        Top             =   840
124 <      Width           =   5415
124 >      Width           =   3855
125     End
126   End
127   Attribute VB_Name = "Form1"
# Line 117 | Line 129 | Attribute VB_GlobalNameSpace = False
129   Attribute VB_Creatable = False
130   Attribute VB_PredeclaredId = True
131   Attribute VB_Exposed = False
132 + ' For the system tray bits
133   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
134   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
135  
136   Dim filterManagerHostname As String
137 < Dim filterManagerTCPPort As Integer
137 > Dim filterManagerTCPPort As Long
138  
139 + Dim seqNo As Long
140 + Dim machineName As String
141 +
142   Dim filterHostname As String
143   Dim filterTCPPort As Integer
144   Dim filterUDPPort As Integer
# Line 134 | Line 150 | Dim TCPUpdateTime As Integer
150  
151   Dim protocolVersion As String
152   Dim connected As Boolean
137 Dim responseNumber As Integer
153  
154 + Dim CUpTime As New CUpTime
155 + Dim wksta As New CNetWksta
156  
157 < Private Sub Command1_Click()
157 > Dim windowBig As Boolean
158  
159 <    ' build the contents of the XML packet.
143 <    xml = "<packet></packet>"
159 > Dim responseNumber As Integer
160  
161 <    ' Use the first winsock control to send a UDP packet.
146 <    UDPSock.RemoteHost = filterHostname
147 <    UDPSock.RemotePort = filterUDPPort
148 <    UDPSock.SendData xml
149 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
161 > Private Sub Command1_Click()
162  
163 < End Sub
163 >    ' Toggle visibility of the debug output.
164  
165 +    If windowBig Then
166 +        Form1.Height = 1500
167 +        windowBig = False
168 +    Else
169 +        Form1.Height = 4350
170 +        windowBig = True
171 +    End If
172  
154 Private Sub Command3_Click()
155    ' establish a TCP connection to a filter
156    TCPSock.Close
157    TCPSock.Connect filterHostname, filterTCPPort
173   End Sub
174  
175   Private Sub Form_Load()
176 +    
177 +    If App.PrevInstance Then
178 +        x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
179 +        End
180 +    End If
181 +    
182      protocolVersion = "1.1"
183 <      
183 >    
184      Status.Caption = "Loading"
185      Form1.Caption = "i-scream Winhost " & protocolVersion
186      
187 +    CUpTime.Init
188 +    
189 +    If CUpTime.isWin9x Then
190 +        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
191 +        End
192 +    End If
193 +    
194 +    windowBig = False
195 +    
196      ''''TEMP
197 <    filterManagerHostname = "killigrew.ukc.ac.uk"
198 <    filterManagerTCPPort = 4567
199 <    Reconfigure_Click
170 <    Exit Sub
171 <    ''' ENDTEMP
197 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
198 >    'filterManagerTCPPort = 4567
199 >    ''''' END TEMP
200      
201 +    'GoTo skip
202      On Error GoTo iniError
203      Dim buf As String * 256
204      Dim length As Long
205 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
205 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
206      filterManagerHostname = Left$(buf, length)
207 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
208 <    filterManagerTCPPort = Left$(buf, length)
207 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
208 >    filterManagerTCPPort = length
209 >    If filterManagerHostname = "" Then
210 >        GoTo iniError
211 >    End If
212 >    On Error GoTo 0
213 > skip:
214 >
215 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
216 >    Reconfigure_Click
217      
218 <    Status.Caption = "Connecting to Filter Manager"
218 >    SystemTray.Icon = Val(Form1.Icon)
219 >    SystemTray.Action = 0
220      
221 +    
222      Exit Sub
223      
224   iniError:
225 <    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")
225 >    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")
226      End
227      
228   End Sub
# Line 192 | Line 231 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
231      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")
232      If x = 7 Then
233          Cancel = True
234 +    Else
235 +        SystemTray.Action = 2
236      End If
237  
238   End Sub
# Line 199 | Line 240 | End Sub
240   Private Sub Hide_Click()
241      Form1.Visible = False
242      SystemTray.Icon = Val(Form1.Icon)
202    SystemTray.Action = 0
243   End Sub
244  
245   Private Sub Reconfigure_Click()
# Line 243 | Line 283 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
283      ' Remove linefeeds and returns from the line.
284      response = Replace(response, Chr(13), "")
285      response = Replace(response, Chr(10), "")
286 <    Text4.Text = Text4.Text & vbCrLf & response
286 >    'Text4.Text = Text4.Text & vbCrLf & response
287      
288      If connected = False Then
289          ' Perform TCP configuration (1.1)
# Line 252 | Line 292 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
292              Case 1:
293                  If Not response = "OK" Then GoTo configError
294                  TCPSock.SendData "LASTMODIFIED" & vbCrLf
295 +                Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
296 +                Text1.Text = Text1.Text & response & vbCrLf
297              Case 2:
298                  If response = "ERROR" Then GoTo configError
299                  lastModified = response
300 +                Text1.Text = Text1.Text & response & vbCrLf
301                  TCPSock.SendData "FILELIST" & vbCrLf
302 +            ''' Uncomment this for new protocol release.
303 +            'Case 2a:
304 +                'If response = "ERROR" Then GoTo configError
305 +                'fileList = response
306 +                'Text1.Text = Text1.Text & response & vbCrLf
307 +                'TCPSock.SendData "FQDN" & vbCrLf
308              Case 3:
309                  If response = "ERROR" Then GoTo configError
310                  fileList = response
311 +                Text1.Text = Text1.Text & response & vbCrLf
312 +                ' REMOVE above line, uncomment next
313 +                'machineName = response
314                  TCPSock.SendData "UDPUpdateTime" & vbCrLf
315              Case 4:
316                  If response = "ERROR" Then GoTo configError
317                  UDPUpdateTime = response
318 +                Text1.Text = Text1.Text & response & vbCrLf
319                  TCPSock.SendData "TCPUpdateTime" & vbCrLf
320              Case 5:
321                  If response = "ERROR" Then GoTo configError
322                  TCPUpdateTime = response
323 +                Text1.Text = Text1.Text & response & vbCrLf
324                  TCPSock.SendData "ENDCONFIG" & vbCrLf
325              Case 6:
326                  If Not response = "OK" Then GoTo configError
327 +                Text1.Text = Text1.Text & response & vbCrLf
328                  TCPSock.SendData "FILTER" & vbCrLf
329              Case 7:
330 +                Text1.Text = Text1.Text & response & vbCrLf
331                  'we got a filter list here.
332                  readTo = 0
333                  ' get hostname
# Line 290 | Line 346 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
346                  connected = True
347                  responseNumber = 0
348                  TCPSock.Close
349 <                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
349 >                Text1.Text = Text1.Text & response & vbCrLf
350 >                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
351                  Status.Caption = "Configuration successful"
352                  Label3.Caption = UDPUpdateTime
353                  Label4.Caption = TCPUpdateTime
# Line 302 | Line 359 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
359          Select Case responseNumber
360              Case 1:
361                  If Not response = "OK" Then GoTo heartbeatError
362 +                Text1.Text = "Performing heartbeat: -" & vbCrLf
363 +                Text1.Text = Text1.Text & response & vbCrLf
364                  TCPSock.SendData "CONFIG" & vbCrLf
365              Case 2:
366                  If Not response = "OK" Then GoTo heartbeatError
367 +                Text1.Text = Text1.Text & response & vbCrLf
368                  TCPSock.SendData fileList & vbCrLf
369              Case 3:
370                  If Not response = "OK" Then GoTo heartbeatError
371 +                Text1.Text = Text1.Text & response & vbCrLf
372                  TCPSock.SendData lastModified & vbCrLf
373              Case 4:
374                  If Not response = "OK" Then GoTo heartbeatError
375 +                Text1.Text = Text1.Text & response & vbCrLf
376                  TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
377              Case 5:
378                  If Not response = "OK" Then GoTo heartbeatError
379 +                Text1.Text = Text1.Text & response & vbCrLf
380                  TCPSock.Close
381                  Status.Caption = "Heartbeat sent successfully."
382          End Select
# Line 339 | Line 402 | Private Sub Timer1_Timer()
402      Status.Caption = ""
403      
404      If Label3.Caption < 1 Then
405 <        ' build the contents of the XML packet.
406 <        xml = "<packet></packet>"
405 >        
406 >        ' prepare the contents of the XML packet.
407 >        seqNo = seqNo + 1
408 >        
409 >        ' Comment this line in the next protocol
410 >        machineName = TCPSock.LocalHostName
411 >        
412 >        LocalIP = TCPSock.LocalIP
413 >        packetDate = Date2Num()
414 >        
415 >        
416 >        Dim verinfo As OSVERSIONINFO
417 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
418 >        ret% = GetVersionEx(verinfo)
419 >        If ret% = 0 Then
420 >            MsgBox "Error getting Windows version Information"
421 >            End
422 >        End If
423 >          
424 >        osName = GetVersion()
425 >        osVersionMajor = verinfo.dwMajorVersion
426 >        osVersionMinor = verinfo.dwMinorVersion
427 >        osBuild = verinfo.dwBuildNumber
428 >        
429 >        Dim sysinfo As SYSTEM_INFO
430 >        GetSystemInfo sysinfo
431 >        Select Case sysinfo.dwProcessorType
432 >            Case PROCESSOR_INTEL_386
433 >                processorType = "Intel 386"
434 >            Case PROCESSOR_INTEL_486
435 >                processorType = "Intel 486"
436 >            Case PROCESSOR_INTEL_PENTIUM
437 >                processorType = "Intel Pentium variant"
438 >            Case PROCESSOR_MIPS_R4000
439 >                processorType = "MIPS R4000"
440 >            Case PROCESSOR_ALPHA_21064
441 >                processorType = "DEC Alpha 21064"
442 >            Case Else
443 >                processorType = "(unknown)"
444 >        End Select
445 >        
446 >        Dim memsts As MEMORYSTATUS
447 >        Dim memory&
448 >        GlobalMemoryStatus memsts
449 >        memory& = memsts.dwTotalPhys
450 >        memTotal = memory& \ 1024
451 >        memory& = memsts.dwAvailPhys
452 >        memFree = memory& \ 1024
453 >        memory& = memsts.dwTotalVirtual
454 >        swapTotal = memory& \ 1024
455 >        memory& = memsts.dwAvailVirtual
456 >        swapFree = memory& \ 1024
457 >        
458 >        uptime = CUpTime.MilliSecs \ 1000
459 >        
460 >        CUpTime.Capture
461 >        cpu_time = CUpTime.CPUTime
462 >        percent_idle = CUpTime.PercentIdle
463 >        
464 >        ' build the contents of the XML packet
465 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
466 >              "<os>" & _
467 >                "<name>" & osName & "</name>" & _
468 >                "<version>" & osVersionMajor & "</version>" & _
469 >                "<release>" & osBuild & "</release>" & _
470 >                "<platform>" & osName & "</platform>" & _
471 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
472 >                "<processor>" & processorType & "</processor>" & _
473 >                "<uptime>" & uptime & "</uptime>" & _
474 >              "</os>" & _
475 >              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
476 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
477 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
478 >              "</packet>"
479 >        Text1.Text = "Last packet contained: -" & vbCrLf & xml
480  
481          ' Use the first winsock control to send a UDP packet.
482          UDPSock.RemoteHost = filterHostname
# Line 358 | Line 494 | Private Sub Timer1_Timer()
494      End If
495  
496   End Sub
497 +
498 + Function Date2Num() As Long
499 +    Dim x As Long
500 +    x = DateDiff("s", "1-1-1970", Now)
501 +    Date2Num = x
502 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines