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.9 by pjm2, Fri Feb 23 11:30:25 2001 UTC vs.
Revision 1.15 by pjm2, Fri Feb 23 17:08:37 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     =   3  'Fixed Dialog
6 <   Caption         =   "TCP/UDP Test program"
5 >   BorderStyle     =   4  'Fixed ToolWindow
6 >   Caption         =   "i-scream Winhost"
7     ClientHeight    =   5655
8     ClientLeft      =   45
9 <   ClientTop       =   330
10 <   ClientWidth     =   5670
9 >   ClientTop       =   285
10 >   ClientWidth     =   4710
11     LinkTopic       =   "Form1"
12     MaxButton       =   0   'False
12 –   MinButton       =   0   'False
13     ScaleHeight     =   5655
14 <   ScaleWidth      =   5670
14 >   ScaleWidth      =   4710
15     ShowInTaskbar   =   0   'False
16     StartUpPosition =   3  'Windows Default
17 <   Begin VB.Timer Timer1
18 <      Left            =   3840
19 <      Top             =   120
20 <   End
21 <   Begin VB.CommandButton Command3
22 <      Caption         =   "TCP to Filter"
17 >   Begin VB.CommandButton Hide
18 >      Caption         =   "Hide Window"
19        Height          =   375
20 <      Left            =   3720
21 <      TabIndex        =   3
22 <      Top             =   2520
23 <      Width           =   1575
20 >      Left            =   3120
21 >      TabIndex        =   7
22 >      Top             =   840
23 >      Width           =   1455
24     End
25 +   Begin SysTray.SystemTray SystemTray
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            =   2760
35 +      Top             =   1800
36 +   End
37     Begin VB.TextBox Text4
38        Height          =   1575
39        Left            =   240
40        MultiLine       =   -1  'True
41        ScrollBars      =   2  'Vertical
42 <      TabIndex        =   2
42 >      TabIndex        =   1
43        Text            =   "nettest.frx":0000
44        Top             =   3000
45 <      Width           =   5055
45 >      Width           =   3975
46     End
47 <   Begin VB.CommandButton Command2
48 <      Caption         =   "TCP to FilterManager"
47 >   Begin VB.CommandButton Reconfigure
48 >      Caption         =   "Reconfigure with FilterManager"
49        Height          =   375
50 <      Left            =   3360
51 <      TabIndex        =   1
52 <      Top             =   2040
53 <      Width           =   1935
50 >      Left            =   120
51 >      TabIndex        =   0
52 >      Top             =   840
53 >      Width           =   2895
54     End
55     Begin MSWinsockLib.Winsock TCPSock
56 <      Left            =   4920
57 <      Top             =   120
56 >      Left            =   3720
57 >      Top             =   1800
58        _ExtentX        =   741
59        _ExtentY        =   741
60        _Version        =   393216
61     End
54 –   Begin VB.CommandButton Command1
55 –      Caption         =   "Send UDP"
56 –      Height          =   375
57 –      Left            =   4320
58 –      TabIndex        =   0
59 –      Top             =   1560
60 –      Width           =   975
61 –   End
62     Begin MSWinsockLib.Winsock UDPSock
63 <      Left            =   4320
64 <      Top             =   120
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            =   120
75 <      TabIndex        =   8
74 >      Left            =   2400
75 >      TabIndex        =   6
76        Top             =   480
77        Width           =   1455
78     End
# Line 80 | Line 80 | Begin VB.Form Form1
80        Alignment       =   1  'Right Justify
81        Caption         =   "Next UDP packet:"
82        Height          =   255
83 <      Left            =   120
84 <      TabIndex        =   7
83 >      Left            =   2400
84 >      TabIndex        =   5
85        Top             =   120
86        Width           =   1455
87     End
88     Begin VB.Label Label4
89 +      BorderStyle     =   1  'Fixed Single
90        Caption         =   "0"
91        Height          =   255
92 <      Left            =   1680
93 <      TabIndex        =   6
92 >      Left            =   3960
93 >      TabIndex        =   4
94        Top             =   480
95        Width           =   615
96     End
97     Begin VB.Label Label3
98 +      BorderStyle     =   1  'Fixed Single
99        Caption         =   "0"
100        Height          =   255
101 <      Left            =   1680
102 <      TabIndex        =   5
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        =   4
112 <      Top             =   5280
113 <      Width           =   5415
111 >      TabIndex        =   2
112 >      Top             =   1320
113 >      Width           =   4455
114     End
115   End
116   Attribute VB_Name = "Form1"
# Line 115 | 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 141 | Dim protocolVersion As String
141   Dim connected As Boolean
142   Dim responseNumber As Integer
143  
137 –
138 – Private Sub Command1_Click()
139 –
140 –    ' build the contents of the XML packet.
141 –    xml = "<packet></packet>"
142 –
143 –    ' Use the first winsock control to send a UDP packet.
144 –    UDPSock.RemoteHost = filterHostname
145 –    UDPSock.RemotePort = filterUDPPort
146 –    UDPSock.SendData xml
147 –    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
148 –
149 – End Sub
150 –
151 – Private Sub Command2_Click()
152 –    
153 –    ' establish a TCP connection to a filtermanager
154 –    TCPSock.Close
155 –    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
156 –
157 – End Sub
158 –
159 – Private Sub Command3_Click()
160 –    ' establish a TCP connection to a filter
161 –    TCPSock.Close
162 –    TCPSock.Connect filterHostname, filterTCPPort
163 – End Sub
164 –
144   Private Sub Form_Load()
145 +    
146      protocolVersion = "1.1"
147      
148 <    Status.Caption = "i-scream Winhost " & protocolVersion
148 >    Status.Caption = "Loading"
149 >    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
150      
151      ''''TEMP
152      filterManagerHostname = "killigrew.ukc.ac.uk"
153      filterManagerTCPPort = 4567
154 <    Exit Sub
174 <    ''' ENDTEMP
154 >    ''''' END TEMP
155      
156 +    GoTo skip
157      On Error GoTo iniError
158      Dim buf As String * 256
159      Dim length As Long
# Line 180 | Line 161 | Private Sub Form_Load()
161      filterManagerHostname = Left$(buf, length)
162      length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
163      filterManagerTCPPort = Left$(buf, length)
164 + skip:
165 +
166 +    Status.Caption = "Connecting to Filter Manager"
167 +    Reconfigure_Click
168      
169 <    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
169 >    Form1.Show
170 >    SystemTray.Action = 0
171      
172 +    
173      Exit Sub
174      
175   iniError:
# Line 191 | Line 178 | iniError:
178      
179   End Sub
180  
181 + Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
182 +    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")
183 +    If x = 7 Then
184 +        Cancel = True
185 +    Else
186 +        SystemTray.Action = 2
187 +    End If
188 +
189 + End Sub
190 +
191 + Private Sub Hide_Click()
192 +    Form1.Visible = False
193 +    SystemTray.Icon = Val(Form1.Icon)
194 + End Sub
195 +
196 + Private Sub Reconfigure_Click()
197 +    ' establish a TCP connection to a filtermanager
198 +    connected = False
199 +    TCPSock.Close
200 +    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
201 + End Sub
202 +
203 +
204 +
205 + Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
206 +
207 +    Form1.Visible = True
208 +    Form1.SetFocus
209 +    
210 +
211 + End Sub
212 +
213   Private Sub TCPSock_Connect()
214      
215      responseNumber = 0
# Line 264 | Line 283 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
283                  responseNumber = 0
284                  TCPSock.Close
285                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
286 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
286 >                Status.Caption = "Configuration successful"
287                  Label3.Caption = UDPUpdateTime
288                  Label4.Caption = TCPUpdateTime
289                  Timer1.Interval = 1000
# Line 288 | Line 307 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
307              Case 5:
308                  If Not response = "OK" Then GoTo heartbeatError
309                  TCPSock.Close
310 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
310 >                Status.Caption = "Heartbeat sent successfully."
311          End Select
312      
313      End If
# Line 297 | Line 316 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
316      Exit Sub
317      
318   configError:
319 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
319 >    Status.Caption = "FAILED to get configuration"
320      Exit Sub
321   heartbeatError:
322 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
322 >    Status.Caption = "Heatbeat FAILED"
323      Exit Sub
324   End Sub
325  
307 – Private Sub TCPTimer_Timer()
308 –    
309 –    ' establish a TCP connection to a filter
310 –    TCPSock.Close
311 –    TCPSock.Connect filterHostname, filterTCPPort
312 –
313 – End Sub
314 –
315 – Private Sub UDPTimer_Timer()
316 –    
317 –    ' build the contents of the XML packet.
318 –    xml = "<packet></packet>"
319 –
320 –    ' Use the first winsock control to send a UDP packet.
321 –    UDPSock.RemoteHost = filterHostname
322 –    UDPSock.RemotePort = filterUDPPort
323 –    UDPSock.SendData xml
324 –    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
325 –
326 – End Sub
327 –
326   Private Sub Timer1_Timer()
327  
328      Label3.Caption = Label3.Caption - 1
329      Label4.Caption = Label4.Caption - 1
330      
331 <    Status.Caption = "i-scream Winhost " & protocolVersion
331 >    Status.Caption = ""
332      
333      If Label3.Caption < 1 Then
334 <        ' build the contents of the XML packet.
335 <        xml = "<packet></packet>"
334 >        
335 >        ' prepare the contents of the XML packet.
336 >        seqNo = seqNo + 1
337 >        machineName = TCPSock.LocalHostName
338 >        localIP = TCPSock.localIP
339 >        packetDate = Date2Num()
340 >        
341 >        
342 >        Dim verinfo As OSVERSIONINFO
343 >        verinfo.dwOSVersionInfoSize = Len(verinfo)
344 >        ret% = GetVersionEx(verinfo)
345 >        If ret% = 0 Then
346 >            MsgBox "Error getting Windows version Information"
347 >            End
348 >        End If
349 >          
350 >        osName = getVersion()
351 >        osVersionMajor = verinfo.dwMajorVersion
352 >        osVersionMinor = verinfo.dwMinorVersion
353 >        osBuild = verinfo.dwBuildNumber
354 >        
355 >        Dim sysinfo As SYSTEM_INFO
356 >        GetSystemInfo sysinfo
357 >        Select Case sysinfo.dwProcessorType
358 >            Case PROCESSOR_INTEL_386
359 >                processorType = "Intel 386"
360 >            Case PROCESSOR_INTEL_486
361 >                processorType = "Intel 486"
362 >            Case PROCESSOR_INTEL_PENTIUM
363 >                processorType = "Intel Pentium variant"
364 >            Case PROCESSOR_MIPS_R4000
365 >                processorType = "MIPS R4000"
366 >            Case PROCESSOR_ALPHA_21064
367 >                processorType = "DEC Alpha 21064"
368 >            Case Else
369 >                processorType = "(unknown)"
370 >        End Select
371 >        
372 >        Dim memsts As MEMORYSTATUS
373 >        Dim memory&
374 >        GlobalMemoryStatus memsts
375 >        memory& = memsts.dwTotalPhys
376 >        memTotal = memory& \ 1024
377 >        memory& = memsts.dwAvailPhys
378 >        memFree = memory& \ 1024
379 >        memory& = memsts.dwTotalVirtual
380 >        swapTotal = memory& \ 1024
381 >        memory& = memsts.dwAvailVirtual
382 >        swapFree = memory& \ 1024
383 >        
384 >        ' build the contents of the XML packet
385 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
386 >              "<os>" & _
387 >                "<name>" & osName & "</name>" & _
388 >                "<version>" & osVersionMajor & "</version>" & _
389 >                "<release>" & osBuild & "</release>" & _
390 >                "<platform>" & osName & "</platform>" & _
391 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
392 >                "<processor>" & processorType & "</processor>" & _
393 >              "</os>" & _
394 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
395 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
396 >              ""
397 >        Text4.Text = Text4.Text + xml
398  
399          ' Use the first winsock control to send a UDP packet.
400          UDPSock.RemoteHost = filterHostname
401          UDPSock.RemotePort = filterUDPPort
402          UDPSock.SendData xml
403 <        Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
403 >        Status.Caption = "UDP packet sent"
404          Label3.Caption = UDPUpdateTime
405      End If
406      
# Line 352 | Line 412 | Private Sub Timer1_Timer()
412      End If
413  
414   End Sub
415 +
416 + Function Date2Num() As Long
417 +    Dim x As Long
418 +    x = DateDiff("s", "1-1-1970", Now)
419 +    Date2Num = x
420 + End Function

Diff Legend

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