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.16 by pjm2, Fri Feb 23 17:31:44 2001 UTC

# Line 7 | Line 7 | Begin VB.Form Form1
7     ClientHeight    =   5655
8     ClientLeft      =   45
9     ClientTop       =   285
10 <   ClientWidth     =   5670
10 >   ClientWidth     =   4710
11     LinkTopic       =   "Form1"
12     MaxButton       =   0   'False
13     ScaleHeight     =   5655
14 <   ScaleWidth      =   5670
14 >   ScaleWidth      =   4710
15     ShowInTaskbar   =   0   'False
16     StartUpPosition =   3  'Windows Default
17     Begin VB.CommandButton Hide
18 <      Caption         =   "Hide"
19 <      Height          =   495
20 <      Left            =   1800
18 >      Caption         =   "Hide Window"
19 >      Height          =   375
20 >      Left            =   3120
21        TabIndex        =   7
22 <      Top             =   2160
23 <      Width           =   1215
22 >      Top             =   840
23 >      Width           =   1455
24     End
25     Begin SysTray.SystemTray SystemTray
26 <      Left            =   3600
27 <      Top             =   1200
26 >      Left            =   2160
27 >      Top             =   1800
28        _ExtentX        =   847
29        _ExtentY        =   847
30        SysTrayText     =   "i-scream Winhost"
31        IconFile        =   0
32     End
33     Begin VB.Timer Timer1
34 <      Left            =   4200
35 <      Top             =   1200
34 >      Left            =   2760
35 >      Top             =   1800
36     End
37     Begin VB.TextBox Text4
38        Height          =   1575
# Line 42 | Line 42 | Begin VB.Form Form1
42        TabIndex        =   1
43        Text            =   "nettest.frx":0000
44        Top             =   3000
45 <      Width           =   5055
45 >      Width           =   3975
46     End
47     Begin VB.CommandButton Reconfigure
48        Caption         =   "Reconfigure with FilterManager"
49 <      Height          =   495
49 >      Height          =   375
50        Left            =   120
51        TabIndex        =   0
52 <      Top             =   120
52 >      Top             =   840
53        Width           =   2895
54     End
55     Begin MSWinsockLib.Winsock TCPSock
56 <      Left            =   5160
57 <      Top             =   1200
56 >      Left            =   3720
57 >      Top             =   1800
58        _ExtentX        =   741
59        _ExtentY        =   741
60        _Version        =   393216
61     End
62     Begin MSWinsockLib.Winsock UDPSock
63 <      Left            =   4680
64 <      Top             =   1200
63 >      Left            =   3240
64 >      Top             =   1800
65        _ExtentX        =   741
66        _ExtentY        =   741
67        _Version        =   393216
# Line 71 | Line 71 | Begin VB.Form Form1
71        Alignment       =   1  'Right Justify
72        Caption         =   "Next heartbeat:"
73        Height          =   255
74 <      Left            =   3360
74 >      Left            =   2400
75        TabIndex        =   6
76        Top             =   480
77        Width           =   1455
# Line 80 | Line 80 | Begin VB.Form Form1
80        Alignment       =   1  'Right Justify
81        Caption         =   "Next UDP packet:"
82        Height          =   255
83 <      Left            =   3360
83 >      Left            =   2400
84        TabIndex        =   5
85        Top             =   120
86        Width           =   1455
# Line 89 | Line 89 | Begin VB.Form Form1
89        BorderStyle     =   1  'Fixed Single
90        Caption         =   "0"
91        Height          =   255
92 <      Left            =   4920
92 >      Left            =   3960
93        TabIndex        =   4
94        Top             =   480
95        Width           =   615
# Line 98 | Line 98 | Begin VB.Form Form1
98        BorderStyle     =   1  'Fixed Single
99        Caption         =   "0"
100        Height          =   255
101 <      Left            =   4920
101 >      Left            =   3960
102        TabIndex        =   3
103        Top             =   120
104        Width           =   615
105     End
106     Begin VB.Label Status
107 +      Alignment       =   2  'Center
108        Caption         =   "Status:"
109        Height          =   255
110        Left            =   120
111        TabIndex        =   2
112 <      Top             =   840
113 <      Width           =   5415
112 >      Top             =   1320
113 >      Width           =   4455
114     End
115   End
116   Attribute VB_Name = "Form1"
# Line 117 | Line 118 | Attribute VB_GlobalNameSpace = False
118   Attribute VB_Creatable = False
119   Attribute VB_PredeclaredId = True
120   Attribute VB_Exposed = False
121 + ' For the system tray bits
122   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
123   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
124  
125   Dim filterManagerHostname As String
126   Dim filterManagerTCPPort As Integer
127  
128 + Dim seqNo As Long
129 + Dim machineName As String
130 +
131   Dim filterHostname As String
132   Dim filterTCPPort As Integer
133   Dim filterUDPPort As Integer
# Line 134 | Line 139 | Dim TCPUpdateTime As Integer
139  
140   Dim protocolVersion As String
141   Dim connected As Boolean
137 – Dim responseNumber As Integer
142  
143 + 'Dim CUpTime As New CUpTime
144  
145 < Private Sub Command1_Click()
145 > Dim responseNumber As Integer
146  
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 –
147   Private Sub Form_Load()
148 +    
149      protocolVersion = "1.1"
150 <      
150 >    
151      Status.Caption = "Loading"
152 <    Form1.Caption = "i-scream Winhost " & protocolVersion
152 >    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
153      
154      ''''TEMP
155      filterManagerHostname = "killigrew.ukc.ac.uk"
156      filterManagerTCPPort = 4567
157 <    Reconfigure_Click
170 <    Exit Sub
171 <    ''' ENDTEMP
157 >    ''''' END TEMP
158      
159 +    GoTo skip
160      On Error GoTo iniError
161      Dim buf As String * 256
162      Dim length As Long
# Line 177 | Line 164 | Private Sub Form_Load()
164      filterManagerHostname = Left$(buf, length)
165      length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
166      filterManagerTCPPort = Left$(buf, length)
167 <    
167 > skip:
168 >
169      Status.Caption = "Connecting to Filter Manager"
170 +    Reconfigure_Click
171      
172 +    Form1.Show
173 +    SystemTray.Action = 0
174 +    
175 +    
176      Exit Sub
177      
178   iniError:
# Line 192 | Line 185 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
185      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")
186      If x = 7 Then
187          Cancel = True
188 +    Else
189 +        SystemTray.Action = 2
190      End If
191  
192   End Sub
# Line 199 | Line 194 | End Sub
194   Private Sub Hide_Click()
195      Form1.Visible = False
196      SystemTray.Icon = Val(Form1.Icon)
202 –    SystemTray.Action = 0
197   End Sub
198  
199   Private Sub Reconfigure_Click()
# Line 215 | Line 209 | Private Sub SystemTray_MouseDblClk(ByVal Button As Int
209  
210      Form1.Visible = True
211      Form1.SetFocus
212 +    
213  
214   End Sub
215  
# Line 339 | Line 334 | Private Sub Timer1_Timer()
334      Status.Caption = ""
335      
336      If Label3.Caption < 1 Then
337 <        ' build the contents of the XML packet.
338 <        xml = "<packet></packet>"
337 >        
338 >        ' prepare the contents of the XML packet.
339 >        seqNo = seqNo + 1
340 >        machineName = TCPSock.LocalHostName
341 >        LocalIP = TCPSock.LocalIP
342 >        packetDate = Date2Num()
343 >        
344 >        
345 >        Dim verinfo As OSVERSIONINFO
346 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
347 >        ret% = GetVersionEx(verinfo)
348 >        If ret% = 0 Then
349 >            MsgBox "Error getting Windows version Information"
350 >            End
351 >        End If
352 >          
353 >        osName = getVersion()
354 >        osVersionMajor = verinfo.dwMajorVersion
355 >        osVersionMinor = verinfo.dwMinorVersion
356 >        osBuild = verinfo.dwBuildNumber
357 >        
358 >        Dim sysinfo As SYSTEM_INFO
359 >        GetSystemInfo sysinfo
360 >        Select Case sysinfo.dwProcessorType
361 >            Case PROCESSOR_INTEL_386
362 >                processorType = "Intel 386"
363 >            Case PROCESSOR_INTEL_486
364 >                processorType = "Intel 486"
365 >            Case PROCESSOR_INTEL_PENTIUM
366 >                processorType = "Intel Pentium variant"
367 >            Case PROCESSOR_MIPS_R4000
368 >                processorType = "MIPS R4000"
369 >            Case PROCESSOR_ALPHA_21064
370 >                processorType = "DEC Alpha 21064"
371 >            Case Else
372 >                processorType = "(unknown)"
373 >        End Select
374 >        
375 >        Dim memsts As MEMORYSTATUS
376 >        Dim memory&
377 >        GlobalMemoryStatus memsts
378 >        memory& = memsts.dwTotalPhys
379 >        memTotal = memory& \ 1024
380 >        memory& = memsts.dwAvailPhys
381 >        memFree = memory& \ 1024
382 >        memory& = memsts.dwTotalVirtual
383 >        swapTotal = memory& \ 1024
384 >        memory& = memsts.dwAvailVirtual
385 >        swapFree = memory& \ 1024
386 >        
387 >        ' build the contents of the XML packet
388 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
389 >              "<os>" & _
390 >                "<name>" & osName & "</name>" & _
391 >                "<version>" & osVersionMajor & "</version>" & _
392 >                "<release>" & osBuild & "</release>" & _
393 >                "<platform>" & osName & "</platform>" & _
394 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
395 >                "<processor>" & processorType & "</processor>" & _
396 >              "</os>" & _
397 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
398 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
399 >              ""
400 >        Text4.Text = Text4.Text + xml
401  
402          ' Use the first winsock control to send a UDP packet.
403          UDPSock.RemoteHost = filterHostname
# Line 358 | Line 415 | Private Sub Timer1_Timer()
415      End If
416  
417   End Sub
418 +
419 + Function Date2Num() As Long
420 +    Dim x As Long
421 +    x = DateDiff("s", "1-1-1970", Now)
422 +    Date2Num = x
423 + End Function

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines