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.10 by pjm2, Fri Feb 23 11:42:06 2001 UTC vs.
Revision 1.19 by pjm2, Mon Feb 26 08:53:48 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     =   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     LinkTopic       =   "Form1"
12     MaxButton       =   0   'False
13     MinButton       =   0   'False
14     ScaleHeight     =   5655
15 <   ScaleWidth      =   5670
15 >   ScaleWidth      =   4710
16     ShowInTaskbar   =   0   'False
17     StartUpPosition =   3  'Windows Default
18 +   Begin VB.CommandButton Hide
19 +      Caption         =   "Hide Window"
20 +      Height          =   375
21 +      Left            =   3120
22 +      TabIndex        =   7
23 +      Top             =   840
24 +      Width           =   1455
25 +   End
26 +   Begin SysTray.SystemTray SystemTray
27 +      Left            =   2160
28 +      Top             =   1800
29 +      _ExtentX        =   847
30 +      _ExtentY        =   847
31 +      SysTrayText     =   "i-scream Winhost"
32 +      IconFile        =   0
33 +   End
34     Begin VB.Timer Timer1
35 <      Left            =   4200
36 <      Top             =   1200
35 >      Left            =   2760
36 >      Top             =   1800
37     End
38     Begin VB.TextBox Text4
39        Height          =   1575
# Line 26 | Line 43 | Begin VB.Form Form1
43        TabIndex        =   1
44        Text            =   "nettest.frx":0000
45        Top             =   3000
46 <      Width           =   5055
46 >      Width           =   3975
47     End
48     Begin VB.CommandButton Reconfigure
49        Caption         =   "Reconfigure with FilterManager"
50 <      Height          =   495
50 >      Height          =   375
51        Left            =   120
52        TabIndex        =   0
53 <      Top             =   120
53 >      Top             =   840
54        Width           =   2895
55     End
56     Begin MSWinsockLib.Winsock TCPSock
57 <      Left            =   5160
58 <      Top             =   1200
57 >      Left            =   3720
58 >      Top             =   1800
59        _ExtentX        =   741
60        _ExtentY        =   741
61        _Version        =   393216
62     End
63     Begin MSWinsockLib.Winsock UDPSock
64 <      Left            =   4680
65 <      Top             =   1200
64 >      Left            =   3240
65 >      Top             =   1800
66        _ExtentX        =   741
67        _ExtentY        =   741
68        _Version        =   393216
69        Protocol        =   1
70     End
71 +   Begin VB.Label Label5
72 +      Caption         =   "b e t a"
73 +      BeginProperty Font
74 +         Name            =   "MS Sans Serif"
75 +         Size            =   24
76 +         Charset         =   0
77 +         Weight          =   700
78 +         Underline       =   0   'False
79 +         Italic          =   0   'False
80 +         Strikethrough   =   0   'False
81 +      EndProperty
82 +      Height          =   615
83 +      Left            =   240
84 +      TabIndex        =   8
85 +      Top             =   120
86 +      Width           =   1815
87 +   End
88     Begin VB.Label Label2
89        Alignment       =   1  'Right Justify
90        Caption         =   "Next heartbeat:"
91        Height          =   255
92 <      Left            =   3360
92 >      Left            =   2400
93        TabIndex        =   6
94        Top             =   480
95        Width           =   1455
# Line 64 | Line 98 | Begin VB.Form Form1
98        Alignment       =   1  'Right Justify
99        Caption         =   "Next UDP packet:"
100        Height          =   255
101 <      Left            =   3360
101 >      Left            =   2400
102        TabIndex        =   5
103        Top             =   120
104        Width           =   1455
# Line 73 | Line 107 | Begin VB.Form Form1
107        BorderStyle     =   1  'Fixed Single
108        Caption         =   "0"
109        Height          =   255
110 <      Left            =   4920
110 >      Left            =   3960
111        TabIndex        =   4
112        Top             =   480
113        Width           =   615
# Line 82 | Line 116 | Begin VB.Form Form1
116        BorderStyle     =   1  'Fixed Single
117        Caption         =   "0"
118        Height          =   255
119 <      Left            =   4920
119 >      Left            =   3960
120        TabIndex        =   3
121        Top             =   120
122        Width           =   615
123     End
124     Begin VB.Label Status
125 +      Alignment       =   2  'Center
126        Caption         =   "Status:"
127        Height          =   255
128 <      Left            =   120
128 >      Left            =   0
129        TabIndex        =   2
130 <      Top             =   840
131 <      Width           =   5415
130 >      Top             =   1320
131 >      Width           =   4695
132     End
133   End
134   Attribute VB_Name = "Form1"
# Line 101 | Line 136 | Attribute VB_GlobalNameSpace = False
136   Attribute VB_Creatable = False
137   Attribute VB_PredeclaredId = True
138   Attribute VB_Exposed = False
139 + ' For the system tray bits
140   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
141   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
142  
143   Dim filterManagerHostname As String
144 < Dim filterManagerTCPPort As Integer
144 > Dim filterManagerTCPPort As Long
145  
146 + Dim seqNo As Long
147 + Dim machineName As String
148 +
149   Dim filterHostname As String
150   Dim filterTCPPort As Integer
151   Dim filterUDPPort As Integer
# Line 118 | Line 157 | Dim TCPUpdateTime As Integer
157  
158   Dim protocolVersion As String
159   Dim connected As Boolean
121 Dim responseNumber As Integer
160  
161 + 'Dim CUpTime As New CUpTime
162  
163 < Private Sub Command1_Click()
163 > Dim responseNumber As Integer
164  
126    ' build the contents of the XML packet.
127    xml = "<packet></packet>"
128
129    ' Use the first winsock control to send a UDP packet.
130    UDPSock.RemoteHost = filterHostname
131    UDPSock.RemotePort = filterUDPPort
132    UDPSock.SendData xml
133    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
134
135 End Sub
136
137
138 Private Sub Command3_Click()
139    ' establish a TCP connection to a filter
140    TCPSock.Close
141    TCPSock.Connect filterHostname, filterTCPPort
142 End Sub
143
165   Private Sub Form_Load()
166 +    
167      protocolVersion = "1.1"
168 <      
168 >    
169      Status.Caption = "Loading"
170 <    Form1.Caption = "i-scream Winhost " & protocolVersion
170 >    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
171      
172      ''''TEMP
173 <    filterManagerHostname = "killigrew.ukc.ac.uk"
174 <    filterManagerTCPPort = 4567
175 <    Reconfigure_Click
154 <    Exit Sub
155 <    ''' ENDTEMP
173 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
174 >    'filterManagerTCPPort = 4567
175 >    ''''' END TEMP
176      
177 +    'GoTo skip
178      On Error GoTo iniError
179      Dim buf As String * 256
180      Dim length As Long
181 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
181 >    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
182      filterManagerHostname = Left$(buf, length)
183 <    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
184 <    filterManagerTCPPort = Left$(buf, length)
183 >    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
184 >    filterManagerTCPPort = length
185 > skip:
186 >
187 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
188 >    Reconfigure_Click
189      
190 <    Status.Caption = "Connecting to Filter Manager"
190 >    Form1.Show
191 >    SystemTray.Action = 0
192      
193 +    
194      Exit Sub
195      
196   iniError:
197 <    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")
197 >    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")
198      End
199      
200   End Sub
201  
202   Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
203 <    x = MsgBox("Are you sure you want to shut down the Winhost?", vbYesNo, "i-scream Winhost")
203 >    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")
204      If x = 7 Then
205          Cancel = True
206 +    Else
207 +        SystemTray.Action = 2
208      End If
209  
210   End Sub
211  
212 + Private Sub Hide_Click()
213 +    Form1.Visible = False
214 +    SystemTray.Icon = Val(Form1.Icon)
215 + End Sub
216 +
217   Private Sub Reconfigure_Click()
218      ' establish a TCP connection to a filtermanager
219      connected = False
# Line 187 | Line 221 | Private Sub Reconfigure_Click()
221      TCPSock.Connect filterManagerHostname, filterManagerTCPPort
222   End Sub
223  
224 +
225 +
226 + Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
227 +
228 +    Form1.Visible = True
229 +    Form1.SetFocus
230 +    
231 +
232 + End Sub
233 +
234   Private Sub TCPSock_Connect()
235      
236      responseNumber = 0
# Line 308 | Line 352 | Private Sub Timer1_Timer()
352      Status.Caption = ""
353      
354      If Label3.Caption < 1 Then
355 <        ' build the contents of the XML packet.
356 <        xml = "<packet></packet>"
355 >        
356 >        ' prepare the contents of the XML packet.
357 >        seqNo = seqNo + 1
358 >        machineName = TCPSock.LocalHostName
359 >        LocalIP = TCPSock.LocalIP
360 >        packetDate = Date2Num()
361 >        
362 >        
363 >        Dim verinfo As OSVERSIONINFO
364 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
365 >        ret% = GetVersionEx(verinfo)
366 >        If ret% = 0 Then
367 >            MsgBox "Error getting Windows version Information"
368 >            End
369 >        End If
370 >          
371 >        osName = getVersion()
372 >        osVersionMajor = verinfo.dwMajorVersion
373 >        osVersionMinor = verinfo.dwMinorVersion
374 >        osBuild = verinfo.dwBuildNumber
375 >        
376 >        Dim sysinfo As SYSTEM_INFO
377 >        GetSystemInfo sysinfo
378 >        Select Case sysinfo.dwProcessorType
379 >            Case PROCESSOR_INTEL_386
380 >                processorType = "Intel 386"
381 >            Case PROCESSOR_INTEL_486
382 >                processorType = "Intel 486"
383 >            Case PROCESSOR_INTEL_PENTIUM
384 >                processorType = "Intel Pentium variant"
385 >            Case PROCESSOR_MIPS_R4000
386 >                processorType = "MIPS R4000"
387 >            Case PROCESSOR_ALPHA_21064
388 >                processorType = "DEC Alpha 21064"
389 >            Case Else
390 >                processorType = "(unknown)"
391 >        End Select
392 >        
393 >        Dim memsts As MEMORYSTATUS
394 >        Dim memory&
395 >        GlobalMemoryStatus memsts
396 >        memory& = memsts.dwTotalPhys
397 >        memTotal = memory& \ 1024
398 >        memory& = memsts.dwAvailPhys
399 >        memFree = memory& \ 1024
400 >        memory& = memsts.dwTotalVirtual
401 >        swapTotal = memory& \ 1024
402 >        memory& = memsts.dwAvailVirtual
403 >        swapFree = memory& \ 1024
404 >        
405 >        uptime = GetTickCount \ 1000
406 >        
407 >        ' build the contents of the XML packet
408 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
409 >              "<os>" & _
410 >                "<name>" & osName & "</name>" & _
411 >                "<version>" & osVersionMajor & "</version>" & _
412 >                "<release>" & osBuild & "</release>" & _
413 >                "<platform>" & osName & "</platform>" & _
414 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
415 >                "<processor>" & processorType & "</processor>" & _
416 >                "<uptime>" & uptime & "</uptime>" & _
417 >              "</os>" & _
418 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
419 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
420 >              "</packet>"
421 >        Text4.Text = Text4.Text + xml
422  
423          ' Use the first winsock control to send a UDP packet.
424          UDPSock.RemoteHost = filterHostname
# Line 327 | Line 436 | Private Sub Timer1_Timer()
436      End If
437  
438   End Sub
439 +
440 + Function Date2Num() As Long
441 +    Dim x As Long
442 +    x = DateDiff("s", "1-1-1970", Now)
443 +    Date2Num = x
444 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines