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.8 by pjm2, Fri Feb 23 11:25:35 2001 UTC vs.
Revision 1.17 by pjm2, Fri Feb 23 17:37:04 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"
6 >   Caption         =   "i-scream Winhost"
7     ClientHeight    =   5655
8     ClientLeft      =   45
9     ClientTop       =   330
10 <   ClientWidth     =   5670
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.Timer Timer1
19 <      Left            =   3840
19 <      Top             =   120
20 <   End
21 <   Begin VB.CommandButton Command3
22 <      Caption         =   "TCP to Filter"
18 >   Begin VB.CommandButton Hide
19 >      Caption         =   "Hide Window"
20        Height          =   375
21 <      Left            =   3720
22 <      TabIndex        =   3
23 <      Top             =   2520
24 <      Width           =   1575
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            =   2760
36 +      Top             =   1800
37 +   End
38     Begin VB.TextBox Text4
39        Height          =   1575
40        Left            =   240
41        MultiLine       =   -1  'True
42        ScrollBars      =   2  'Vertical
43 <      TabIndex        =   2
43 >      TabIndex        =   1
44        Text            =   "nettest.frx":0000
45        Top             =   3000
46 <      Width           =   5055
46 >      Width           =   3975
47     End
48 <   Begin VB.CommandButton Command2
49 <      Caption         =   "TCP to FilterManager"
48 >   Begin VB.CommandButton Reconfigure
49 >      Caption         =   "Reconfigure with FilterManager"
50        Height          =   375
51 <      Left            =   3360
52 <      TabIndex        =   1
53 <      Top             =   2040
54 <      Width           =   1935
51 >      Left            =   120
52 >      TabIndex        =   0
53 >      Top             =   840
54 >      Width           =   2895
55     End
56     Begin MSWinsockLib.Winsock TCPSock
57 <      Left            =   4920
58 <      Top             =   120
57 >      Left            =   3720
58 >      Top             =   1800
59        _ExtentX        =   741
60        _ExtentY        =   741
61        _Version        =   393216
62     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
63     Begin MSWinsockLib.Winsock UDPSock
64 <      Left            =   4320
65 <      Top             =   120
64 >      Left            =   3240
65 >      Top             =   1800
66        _ExtentX        =   741
67        _ExtentY        =   741
68        _Version        =   393216
69        Protocol        =   1
70     End
71 <   Begin VB.Label Label4
72 <      Caption         =   "Label4"
73 <      Height          =   255
74 <      Left            =   1920
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             =   1320
86 <      Width           =   615
85 >      Top             =   120
86 >      Width           =   1815
87     End
78   Begin VB.Label Label3
79      Caption         =   "Label3"
80      Height          =   255
81      Left            =   1920
82      TabIndex        =   7
83      Top             =   960
84      Width           =   615
85   End
88     Begin VB.Label Label2
89 <      Caption         =   "Label2"
89 >      Alignment       =   1  'Right Justify
90 >      Caption         =   "Next heartbeat:"
91        Height          =   255
92 <      Left            =   120
92 >      Left            =   2400
93        TabIndex        =   6
94 <      Top             =   600
95 <      Width           =   3375
94 >      Top             =   480
95 >      Width           =   1455
96     End
97     Begin VB.Label Label1
98 <      Caption         =   "Label1"
98 >      Alignment       =   1  'Right Justify
99 >      Caption         =   "Next UDP packet:"
100        Height          =   255
101 <      Left            =   120
101 >      Left            =   2400
102        TabIndex        =   5
103 <      Top             =   240
104 <      Width           =   3375
103 >      Top             =   120
104 >      Width           =   1455
105     End
106 +   Begin VB.Label Label4
107 +      BorderStyle     =   1  'Fixed Single
108 +      Caption         =   "0"
109 +      Height          =   255
110 +      Left            =   3960
111 +      TabIndex        =   4
112 +      Top             =   480
113 +      Width           =   615
114 +   End
115 +   Begin VB.Label Label3
116 +      BorderStyle     =   1  'Fixed Single
117 +      Caption         =   "0"
118 +      Height          =   255
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
129 <      TabIndex        =   4
130 <      Top             =   5280
131 <      Width           =   5415
129 >      TabIndex        =   2
130 >      Top             =   1320
131 >      Width           =   4455
132     End
133   End
134   Attribute VB_Name = "Form1"
# Line 113 | 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
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 130 | Line 157 | Dim TCPUpdateTime As Integer
157  
158   Dim protocolVersion As String
159   Dim connected As Boolean
133 Dim responseNumber As Integer
160  
161 + 'Dim CUpTime As New CUpTime
162  
163 < Private Sub Command1_Click()
163 > Dim responseNumber As Integer
164  
138    ' build the contents of the XML packet.
139    xml = "<packet></packet>"
140
141    ' Use the first winsock control to send a UDP packet.
142    UDPSock.RemoteHost = filterHostname
143    UDPSock.RemotePort = filterUDPPort
144    UDPSock.SendData xml
145    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
146
147 End Sub
148
149 Private Sub Command2_Click()
150    
151    ' establish a TCP connection to a filtermanager
152    TCPSock.Close
153    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
154
155 End Sub
156
157 Private Sub Command3_Click()
158    ' establish a TCP connection to a filter
159    TCPSock.Close
160    TCPSock.Connect filterHostname, filterTCPPort
161 End Sub
162
165   Private Sub Form_Load()
166 +    
167      protocolVersion = "1.1"
168      
169 <    Status.Caption = "i-scream Winhost " & protocolVersion
169 >    Status.Caption = "Loading"
170 >    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
171      
172      ''''TEMP
173      filterManagerHostname = "killigrew.ukc.ac.uk"
174      filterManagerTCPPort = 4567
175 <    Exit Sub
172 <    ''' ENDTEMP
175 >    ''''' END TEMP
176      
177 +    GoTo skip
178      On Error GoTo iniError
179      Dim buf As String * 256
180      Dim length As Long
# Line 178 | Line 182 | Private Sub Form_Load()
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)
185 + skip:
186 +
187 +    Status.Caption = "Connecting to Filter Manager"
188 +    Reconfigure_Click
189      
190 <    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
190 >    Form1.Show
191 >    SystemTray.Action = 0
192      
193 +    
194      Exit Sub
195      
196   iniError:
# Line 189 | Line 199 | iniError:
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?  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
220 +    TCPSock.Close
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 262 | Line 304 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
304                  responseNumber = 0
305                  TCPSock.Close
306                  Text4.Text = Text4.Text & vbCrLf & "  <closed>"
307 <                Label1.Caption = "TCP hearbeat interval: " & UDPUpdateTime
266 <                Label2.Caption = "UDP packet interval: " & TCPUpdateTime
267 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
307 >                Status.Caption = "Configuration successful"
308                  Label3.Caption = UDPUpdateTime
309                  Label4.Caption = TCPUpdateTime
310                  Timer1.Interval = 1000
# Line 288 | Line 328 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
328              Case 5:
329                  If Not response = "OK" Then GoTo heartbeatError
330                  TCPSock.Close
331 <                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
331 >                Status.Caption = "Heartbeat sent successfully."
332          End Select
333      
334      End If
# Line 297 | Line 337 | Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo
337      Exit Sub
338      
339   configError:
340 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description
340 >    Status.Caption = "FAILED to get configuration"
341      Exit Sub
342   heartbeatError:
343 <    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description
343 >    Status.Caption = "Heatbeat FAILED"
344      Exit Sub
345   End Sub
346  
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
347   Private Sub Timer1_Timer()
348  
349      Label3.Caption = Label3.Caption - 1
350      Label4.Caption = Label4.Caption - 1
351      
352 <    Status.Caption = "i-scream Winhost " & protocolVersion
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 >        ' build the contents of the XML packet
406 >        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
407 >              "<os>" & _
408 >                "<name>" & osName & "</name>" & _
409 >                "<version>" & osVersionMajor & "</version>" & _
410 >                "<release>" & osBuild & "</release>" & _
411 >                "<platform>" & osName & "</platform>" & _
412 >                "<minor_version>" & osVersionMinor & "</minor_version>" & _
413 >                "<processor>" & processorType & "</processor>" & _
414 >              "</os>" & _
415 >              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
416 >              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
417 >              "</packet>"
418 >        Text4.Text = Text4.Text + xml
419  
420          ' Use the first winsock control to send a UDP packet.
421          UDPSock.RemoteHost = filterHostname
422          UDPSock.RemotePort = filterUDPPort
423          UDPSock.SendData xml
424 <        Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
424 >        Status.Caption = "UDP packet sent"
425          Label3.Caption = UDPUpdateTime
426      End If
427      
# Line 352 | Line 433 | Private Sub Timer1_Timer()
433      End If
434  
435   End Sub
436 +
437 + Function Date2Num() As Long
438 +    Dim x As Long
439 +    x = DateDiff("s", "1-1-1970", Now)
440 +    Date2Num = x
441 + End Function

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines