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.12 by pjm2, Fri Feb 23 12:01:14 2001 UTC vs.
Revision 1.24 by pjm2, Mon Feb 26 10:13:10 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
9 >   ClientTop       =   330
10     ClientWidth     =   4710
11 +   Icon            =   "nettest.frx":0000
12     LinkTopic       =   "Form1"
13     MaxButton       =   0   'False
14 <   ScaleHeight     =   5655
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 Window"
22        Height          =   375
23        Left            =   3120
24 <      TabIndex        =   7
25 <      Top             =   840
24 >      TabIndex        =   6
25 >      Top             =   480
26        Width           =   1455
27     End
28     Begin SysTray.SystemTray SystemTray
# Line 34 | Line 37 | Begin VB.Form Form1
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           =   3975
46   End
40     Begin VB.CommandButton Reconfigure
41        Caption         =   "Reconfigure with FilterManager"
42        Height          =   375
43        Left            =   120
44        TabIndex        =   0
45 <      Top             =   840
45 >      Top             =   480
46        Width           =   2895
47     End
48     Begin MSWinsockLib.Winsock TCPSock
# Line 72 | Line 65 | Begin VB.Form Form1
65        Caption         =   "Next heartbeat:"
66        Height          =   255
67        Left            =   2400
68 <      TabIndex        =   6
69 <      Top             =   480
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            =   2400
77 <      TabIndex        =   5
76 >      Left            =   120
77 >      TabIndex        =   4
78        Top             =   120
79        Width           =   1455
80     End
# Line 90 | Line 83 | Begin VB.Form Form1
83        Caption         =   "0"
84        Height          =   255
85        Left            =   3960
86 <      TabIndex        =   4
87 <      Top             =   480
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            =   3960
95 <      TabIndex        =   3
94 >      Left            =   1680
95 >      TabIndex        =   2
96        Top             =   120
97        Width           =   615
98     End
# Line 107 | Line 100 | Begin VB.Form Form1
100        Alignment       =   2  'Center
101        Caption         =   "Status:"
102        Height          =   255
103 <      Left            =   120
104 <      TabIndex        =   2
105 <      Top             =   1320
106 <      Width           =   4455
103 >      Left            =   0
104 >      TabIndex        =   1
105 >      Top             =   960
106 >      Width           =   4695
107     End
108   End
109   Attribute VB_Name = "Form1"
# Line 118 | 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 135 | Line 132 | Dim TCPUpdateTime As Integer
132  
133   Dim protocolVersion As String
134   Dim connected As Boolean
138 Dim responseNumber As Integer
135  
136 + Dim CUpTime As New CUpTime
137  
138 < Private Sub Command1_Click()
138 > Dim responseNumber As Integer
139  
143    ' build the contents of the XML packet.
144    xml = "<packet></packet>"
145
146    ' Use the first winsock control to send a UDP packet.
147    UDPSock.RemoteHost = filterHostname
148    UDPSock.RemotePort = filterUDPPort
149    UDPSock.SendData xml
150    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
151
152 End Sub
153
154
155 Private Sub Command3_Click()
156    ' establish a TCP connection to a filter
157    TCPSock.Close
158    TCPSock.Connect filterHostname, filterTCPPort
159 End Sub
160
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 <      
147 >    
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 <    Reconfigure_Click
171 <    Exit Sub
172 <    ''' 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 = "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
# Line 193 | Line 190 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
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
197    SystemTray.Action = 2
196  
197   End Sub
198  
199   Private Sub Hide_Click()
200      Form1.Visible = False
201      SystemTray.Icon = Val(Form1.Icon)
204    SystemTray.Action = 0
202   End Sub
203  
204   Private Sub Reconfigure_Click()
# Line 216 | Line 213 | End Sub
213   Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
214  
215      Form1.Visible = True
219    SystemTray.Action = 2
216      Form1.SetFocus
221    
217  
218   End Sub
219  
# Line 247 | 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 294 | 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>"
292 >                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
293                  Status.Caption = "Configuration successful"
294                  Label3.Caption = UDPUpdateTime
295                  Label4.Caption = TCPUpdateTime
# Line 343 | Line 338 | Private Sub Timer1_Timer()
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
# Line 362 | 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