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.21 by pjm2, Mon Feb 26 09:23:34 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
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 +   MinButton       =   0   'False
15     ScaleHeight     =   5655
16 <   ScaleWidth      =   5670
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
20 >      Caption         =   "Hide Window"
21 >      Height          =   375
22 >      Left            =   3120
23        TabIndex        =   7
24 <      Top             =   2160
25 <      Width           =   1215
24 >      Top             =   840
25 >      Width           =   1455
26     End
27     Begin SysTray.SystemTray SystemTray
28 <      Left            =   3600
29 <      Top             =   1200
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            =   4200
37 <      Top             =   1200
36 >      Left            =   2760
37 >      Top             =   1800
38     End
39     Begin VB.TextBox Text4
40        Height          =   1575
# Line 40 | Line 42 | Begin VB.Form Form1
42        MultiLine       =   -1  'True
43        ScrollBars      =   2  'Vertical
44        TabIndex        =   1
45 <      Text            =   "nettest.frx":0000
45 >      Text            =   "nettest.frx":0742
46        Top             =   3000
47 <      Width           =   5055
47 >      Width           =   3975
48     End
49     Begin VB.CommandButton Reconfigure
50        Caption         =   "Reconfigure with FilterManager"
51 <      Height          =   495
51 >      Height          =   375
52        Left            =   120
53        TabIndex        =   0
54 <      Top             =   120
54 >      Top             =   840
55        Width           =   2895
56     End
57     Begin MSWinsockLib.Winsock TCPSock
58 <      Left            =   5160
59 <      Top             =   1200
58 >      Left            =   3720
59 >      Top             =   1800
60        _ExtentX        =   741
61        _ExtentY        =   741
62        _Version        =   393216
63     End
64     Begin MSWinsockLib.Winsock UDPSock
65 <      Left            =   4680
66 <      Top             =   1200
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            =   3360
93 >      Left            =   2400
94        TabIndex        =   6
95        Top             =   480
96        Width           =   1455
# Line 80 | Line 99 | Begin VB.Form Form1
99        Alignment       =   1  'Right Justify
100        Caption         =   "Next UDP packet:"
101        Height          =   255
102 <      Left            =   3360
102 >      Left            =   2400
103        TabIndex        =   5
104        Top             =   120
105        Width           =   1455
# Line 89 | Line 108 | Begin VB.Form Form1
108        BorderStyle     =   1  'Fixed Single
109        Caption         =   "0"
110        Height          =   255
111 <      Left            =   4920
111 >      Left            =   3960
112        TabIndex        =   4
113        Top             =   480
114        Width           =   615
# Line 98 | Line 117 | Begin VB.Form Form1
117        BorderStyle     =   1  'Fixed Single
118        Caption         =   "0"
119        Height          =   255
120 <      Left            =   4920
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
129 >      Left            =   0
130        TabIndex        =   2
131 <      Top             =   840
132 <      Width           =   5415
131 >      Top             =   1320
132 >      Width           =   4695
133     End
134   End
135   Attribute VB_Name = "Form1"
# Line 117 | 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 134 | Line 158 | Dim TCPUpdateTime As Integer
158  
159   Dim protocolVersion As String
160   Dim connected As Boolean
137 Dim responseNumber As Integer
161  
162 + Dim CUpTime As New CUpTime
163  
164 < Private Sub Command1_Click()
164 > Dim responseNumber As Integer
165  
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
166   Private Sub Form_Load()
167 +    
168      protocolVersion = "1.1"
169 <      
169 >    
170      Status.Caption = "Loading"
171      Form1.Caption = "i-scream Winhost " & protocolVersion
172      
173 +    Form1.Show
174 +    
175 +    CUpTime.Init
176 +    
177 +    If CUpTime.isWin9x Then
178 +        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server.")
179 +        End
180 +    End If
181 +    
182      ''''TEMP
183 <    filterManagerHostname = "killigrew.ukc.ac.uk"
184 <    filterManagerTCPPort = 4567
185 <    Reconfigure_Click
170 <    Exit Sub
171 <    ''' ENDTEMP
183 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
184 >    'filterManagerTCPPort = 4567
185 >    ''''' END TEMP
186      
187 +    'GoTo skip
188      On Error GoTo iniError
189      Dim buf As String * 256
190      Dim length As Long
191 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
191 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
192      filterManagerHostname = Left$(buf, length)
193 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
194 <    filterManagerTCPPort = Left$(buf, length)
193 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
194 >    filterManagerTCPPort = length
195 >    On Error GoTo 0
196 > skip:
197 >
198 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
199 >    Reconfigure_Click
200      
201 <    Status.Caption = "Connecting to Filter Manager"
201 >    SystemTray.Icon = Val(Form1.Icon)
202 >    SystemTray.Action = 0
203      
204 +    
205      Exit Sub
206      
207   iniError:
208 <    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")
208 >    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")
209      End
210      
211   End Sub
# Line 192 | Line 214 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
214      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")
215      If x = 7 Then
216          Cancel = True
217 +    Else
218 +        SystemTray.Action = 2
219      End If
220  
221   End Sub
# Line 199 | Line 223 | End Sub
223   Private Sub Hide_Click()
224      Form1.Visible = False
225      SystemTray.Icon = Val(Form1.Icon)
202    SystemTray.Action = 0
226   End Sub
227  
228   Private Sub Reconfigure_Click()
# Line 215 | Line 238 | Private Sub SystemTray_MouseDblClk(ByVal Button As Int
238  
239      Form1.Visible = True
240      Form1.SetFocus
241 +    
242  
243   End Sub
244  
# Line 339 | Line 363 | Private Sub Timer1_Timer()
363      Status.Caption = ""
364      
365      If Label3.Caption < 1 Then
366 <        ' build the contents of the XML packet.
367 <        xml = "<packet></packet>"
366 >        
367 >        ' prepare the contents of the XML packet.
368 >        seqNo = seqNo + 1
369 >        machineName = TCPSock.LocalHostName
370 >        LocalIP = TCPSock.LocalIP
371 >        packetDate = Date2Num()
372 >        
373 >        
374 >        Dim verinfo As OSVERSIONINFO
375 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
376 >        ret% = GetVersionEx(verinfo)
377 >        If ret% = 0 Then
378 >            MsgBox "Error getting Windows version Information"
379 >            End
380 >        End If
381 >          
382 >        osName = GetVersion()
383 >        osVersionMajor = verinfo.dwMajorVersion
384 >        osVersionMinor = verinfo.dwMinorVersion
385 >        osBuild = verinfo.dwBuildNumber
386 >        
387 >        Dim sysinfo As SYSTEM_INFO
388 >        GetSystemInfo sysinfo
389 >        Select Case sysinfo.dwProcessorType
390 >            Case PROCESSOR_INTEL_386
391 >                processorType = "Intel 386"
392 >            Case PROCESSOR_INTEL_486
393 >                processorType = "Intel 486"
394 >            Case PROCESSOR_INTEL_PENTIUM
395 >                processorType = "Intel Pentium variant"
396 >            Case PROCESSOR_MIPS_R4000
397 >                processorType = "MIPS R4000"
398 >            Case PROCESSOR_ALPHA_21064
399 >                processorType = "DEC Alpha 21064"
400 >            Case Else
401 >                processorType = "(unknown)"
402 >        End Select
403 >        
404 >        Dim memsts As MEMORYSTATUS
405 >        Dim memory&
406 >        GlobalMemoryStatus memsts
407 >        memory& = memsts.dwTotalPhys
408 >        memTotal = memory& \ 1024
409 >        memory& = memsts.dwAvailPhys
410 >        memFree = memory& \ 1024
411 >        memory& = memsts.dwTotalVirtual
412 >        swapTotal = memory& \ 1024
413 >        memory& = memsts.dwAvailVirtual
414 >        swapFree = memory& \ 1024
415 >        
416 >        uptime = GetTickCount \ 1000
417 >        
418 >        ' build the contents of the XML packet
419 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
420 >              "<os>" & _
421 >                "<name>" & osName & "</name>" & _
422 >                "<version>" & osVersionMajor & "</version>" & _
423 >                "<release>" & osBuild & "</release>" & _
424 >                "<platform>" & osName & "</platform>" & _
425 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
426 >                "<processor>" & processorType & "</processor>" & _
427 >                "<uptime>" & uptime & "</uptime>" & _
428 >              "</os>" & _
429 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
430 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
431 >              "</packet>"
432 >        Text4.Text = Text4.Text + xml
433  
434          ' Use the first winsock control to send a UDP packet.
435          UDPSock.RemoteHost = filterHostname
# Line 358 | Line 447 | Private Sub Timer1_Timer()
447      End If
448  
449   End Sub
450 +
451 + Function Date2Num() As Long
452 +    Dim x As Long
453 +    x = DateDiff("s", "1-1-1970", Now)
454 +    Date2Num = x
455 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines