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.25 by pjm2, Wed Feb 28 08:19:00 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    =   1275
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     =   1275
16 >   ScaleWidth      =   4710
17     ShowInTaskbar   =   0   'False
18 <   StartUpPosition =   3  'Windows Default
18 >   StartUpPosition =   2  'CenterScreen
19 >   Visible         =   0   'False
20     Begin VB.CommandButton Hide
21 <      Caption         =   "Hide"
22 <      Height          =   495
23 <      Left            =   1800
24 <      TabIndex        =   7
25 <      Top             =   2160
26 <      Width           =   1215
21 >      Caption         =   "Hide Window"
22 >      Height          =   375
23 >      Left            =   3120
24 >      TabIndex        =   6
25 >      Top             =   480
26 >      Width           =   1455
27     End
28     Begin SysTray.SystemTray SystemTray
29 <      Left            =   3600
30 <      Top             =   1200
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.Timer Timer1
37 <      Left            =   4200
38 <      Top             =   1200
37 >      Left            =   2760
38 >      Top             =   1800
39     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
40     Begin VB.CommandButton Reconfigure
41        Caption         =   "Reconfigure with FilterManager"
42 <      Height          =   495
42 >      Height          =   375
43        Left            =   120
44        TabIndex        =   0
45 <      Top             =   120
45 >      Top             =   480
46        Width           =   2895
47     End
48     Begin MSWinsockLib.Winsock TCPSock
49 <      Left            =   5160
50 <      Top             =   1200
49 >      Left            =   3720
50 >      Top             =   1800
51        _ExtentX        =   741
52        _ExtentY        =   741
53        _Version        =   393216
54     End
55     Begin MSWinsockLib.Winsock UDPSock
56 <      Left            =   4680
57 <      Top             =   1200
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            =   3360
68 <      TabIndex        =   6
69 <      Top             =   480
67 >      Left            =   2400
68 >      TabIndex        =   5
69 >      Top             =   120
70        Width           =   1455
71     End
72     Begin VB.Label Label1
73        Alignment       =   1  'Right Justify
74        Caption         =   "Next UDP packet:"
75        Height          =   255
76 <      Left            =   3360
77 <      TabIndex        =   5
76 >      Left            =   120
77 >      TabIndex        =   4
78        Top             =   120
79        Width           =   1455
80     End
# Line 89 | Line 82 | Begin VB.Form Form1
82        BorderStyle     =   1  'Fixed Single
83        Caption         =   "0"
84        Height          =   255
85 <      Left            =   4920
86 <      TabIndex        =   4
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            =   4920
95 <      TabIndex        =   3
94 >      Left            =   1680
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        =   2
105 <      Top             =   840
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 117 | 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 134 | Line 132 | Dim TCPUpdateTime As Integer
132  
133   Dim protocolVersion As String
134   Dim connected As Boolean
137 Dim responseNumber As Integer
135  
136 + Dim CUpTime As New CUpTime
137 + Dim wksta As New CNetWksta
138  
139 < Private Sub Command1_Click()
139 > Dim responseNumber As Integer
140  
142    ' build the contents of the XML packet.
143    xml = "<packet></packet>"
144
145    ' 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."
150
151 End Sub
152
153
154 Private Sub Command3_Click()
155    ' establish a TCP connection to a filter
156    TCPSock.Close
157    TCPSock.Connect filterHostname, filterTCPPort
158 End Sub
159
141   Private Sub Form_Load()
142 +    
143 +    If App.PrevInstance Then
144 +        x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
145 +        End
146 +    End If
147 +    
148      protocolVersion = "1.1"
149 <      
149 >    
150      Status.Caption = "Loading"
151      Form1.Caption = "i-scream Winhost " & protocolVersion
152      
153 +    CUpTime.Init
154 +    
155 +    If CUpTime.isWin9x Then
156 +        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
157 +        End
158 +    End If
159 +    
160      ''''TEMP
161 <    filterManagerHostname = "killigrew.ukc.ac.uk"
162 <    filterManagerTCPPort = 4567
163 <    Reconfigure_Click
170 <    Exit Sub
171 <    ''' ENDTEMP
161 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
162 >    'filterManagerTCPPort = 4567
163 >    ''''' END TEMP
164      
165 +    'GoTo skip
166      On Error GoTo iniError
167      Dim buf As String * 256
168      Dim length As Long
169 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
169 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
170      filterManagerHostname = Left$(buf, length)
171 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
172 <    filterManagerTCPPort = Left$(buf, length)
171 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
172 >    filterManagerTCPPort = length
173 >    If filterManagerHostname = "" Then
174 >        GoTo iniError
175 >    End If
176 >    On Error GoTo 0
177 > skip:
178 >
179 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
180 >    Reconfigure_Click
181      
182 <    Status.Caption = "Connecting to Filter Manager"
182 >    SystemTray.Icon = Val(Form1.Icon)
183 >    SystemTray.Action = 0
184      
185 +    
186      Exit Sub
187      
188   iniError:
189 <    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")
189 >    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")
190      End
191      
192   End Sub
# Line 192 | Line 195 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
195      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")
196      If x = 7 Then
197          Cancel = True
198 +    Else
199 +        SystemTray.Action = 2
200      End If
201  
202   End Sub
# Line 199 | Line 204 | End Sub
204   Private Sub Hide_Click()
205      Form1.Visible = False
206      SystemTray.Icon = Val(Form1.Icon)
202    SystemTray.Action = 0
207   End Sub
208  
209   Private Sub Reconfigure_Click()
# Line 243 | Line 247 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
247      ' Remove linefeeds and returns from the line.
248      response = Replace(response, Chr(13), "")
249      response = Replace(response, Chr(10), "")
250 <    Text4.Text = Text4.Text & vbCrLf & response
250 >    'Text4.Text = Text4.Text & vbCrLf & response
251      
252      If connected = False Then
253          ' Perform TCP configuration (1.1)
# Line 290 | Line 294 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
294                  connected = True
295                  responseNumber = 0
296                  TCPSock.Close
297 <                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
297 >                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
298                  Status.Caption = "Configuration successful"
299                  Label3.Caption = UDPUpdateTime
300                  Label4.Caption = TCPUpdateTime
# Line 339 | Line 343 | Private Sub Timer1_Timer()
343      Status.Caption = ""
344      
345      If Label3.Caption < 1 Then
346 <        ' build the contents of the XML packet.
347 <        xml = "<packet></packet>"
346 >        
347 >        ' prepare the contents of the XML packet.
348 >        seqNo = seqNo + 1
349 >        machineName = TCPSock.LocalHostName
350 >        LocalIP = TCPSock.LocalIP
351 >        packetDate = Date2Num()
352 >        
353 >        
354 >        Dim verinfo As OSVERSIONINFO
355 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
356 >        ret% = GetVersionEx(verinfo)
357 >        If ret% = 0 Then
358 >            MsgBox "Error getting Windows version Information"
359 >            End
360 >        End If
361 >          
362 >        osName = GetVersion()
363 >        osVersionMajor = verinfo.dwMajorVersion
364 >        osVersionMinor = verinfo.dwMinorVersion
365 >        osBuild = verinfo.dwBuildNumber
366 >        
367 >        Dim sysinfo As SYSTEM_INFO
368 >        GetSystemInfo sysinfo
369 >        Select Case sysinfo.dwProcessorType
370 >            Case PROCESSOR_INTEL_386
371 >                processorType = "Intel 386"
372 >            Case PROCESSOR_INTEL_486
373 >                processorType = "Intel 486"
374 >            Case PROCESSOR_INTEL_PENTIUM
375 >                processorType = "Intel Pentium variant"
376 >            Case PROCESSOR_MIPS_R4000
377 >                processorType = "MIPS R4000"
378 >            Case PROCESSOR_ALPHA_21064
379 >                processorType = "DEC Alpha 21064"
380 >            Case Else
381 >                processorType = "(unknown)"
382 >        End Select
383 >        
384 >        Dim memsts As MEMORYSTATUS
385 >        Dim memory&
386 >        GlobalMemoryStatus memsts
387 >        memory& = memsts.dwTotalPhys
388 >        memTotal = memory& \ 1024
389 >        memory& = memsts.dwAvailPhys
390 >        memFree = memory& \ 1024
391 >        memory& = memsts.dwTotalVirtual
392 >        swapTotal = memory& \ 1024
393 >        memory& = memsts.dwAvailVirtual
394 >        swapFree = memory& \ 1024
395 >        
396 >        uptime = CUpTime.MilliSecs \ 1000
397 >        
398 >        CUpTime.Capture
399 >        cpu_time = CUpTime.CPUTime
400 >        percent_idle = CUpTime.PercentIdle
401 >        
402 >        ' build the contents of the XML packet
403 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
404 >              "<os>" & _
405 >                "<name>" & osName & "</name>" & _
406 >                "<version>" & osVersionMajor & "</version>" & _
407 >                "<release>" & osBuild & "</release>" & _
408 >                "<platform>" & osName & "</platform>" & _
409 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
410 >                "<processor>" & processorType & "</processor>" & _
411 >                "<uptime>" & uptime & "</uptime>" & _
412 >              "</os>" & _
413 >              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
414 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
415 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
416 >              "</packet>"
417 >        'Text4.Text = Text4.Text + xml
418  
419          ' Use the first winsock control to send a UDP packet.
420          UDPSock.RemoteHost = filterHostname
# Line 358 | Line 432 | Private Sub Timer1_Timer()
432      End If
433  
434   End Sub
435 +
436 + Function Date2Num() As Long
437 +    Dim x As Long
438 +    x = DateDiff("s", "1-1-1970", Now)
439 +    Date2Num = x
440 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines