ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/experimental/host/vb_net_test/nettest.frm
(Generate patch)

Comparing experimental/host/vb_net_test/nettest.frm (file contents):
Revision 1.13 by pjm2, Fri Feb 23 13:23:53 2001 UTC vs.
Revision 1.19 by pjm2, Mon Feb 26 08:53:48 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
9 >   ClientTop       =   330
10     ClientWidth     =   4710
11     LinkTopic       =   "Form1"
12     MaxButton       =   0   'False
13 +   MinButton       =   0   'False
14     ScaleHeight     =   5655
15     ScaleWidth      =   4710
16     ShowInTaskbar   =   0   'False
# Line 67 | Line 68 | Begin VB.Form Form1
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:"
# Line 107 | Line 125 | Begin VB.Form Form1
125        Alignment       =   2  'Center
126        Caption         =   "Status:"
127        Height          =   255
128 <      Left            =   120
128 >      Left            =   0
129        TabIndex        =   2
130        Top             =   1320
131 <      Width           =   4455
131 >      Width           =   4695
132     End
133   End
134   Attribute VB_Name = "Form1"
# Line 118 | 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
# Line 138 | Line 157 | Dim TCPUpdateTime As Integer
157  
158   Dim protocolVersion As String
159   Dim connected As Boolean
160 +
161 + 'Dim CUpTime As New CUpTime
162 +
163   Dim responseNumber As Integer
164  
165   Private Sub Form_Load()
144    x = MsgBox(Date2Num())
166      
167      protocolVersion = "1.1"
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
173 >    'filterManagerHostname = "killigrew.ukc.ac.uk"
174 >    'filterManagerTCPPort = 4567
175      ''''' END TEMP
176      
177 <    GoTo skip
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"
187 >    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
188      Reconfigure_Click
189      
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
# Line 178 | Line 203 | Private Sub Form_QueryUnload(Cancel As Integer, Unload
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
182    SystemTray.Action = 2
209  
210   End Sub
211  
212   Private Sub Hide_Click()
213      Form1.Visible = False
214      SystemTray.Icon = Val(Form1.Icon)
189    SystemTray.Action = 0
215   End Sub
216  
217   Private Sub Reconfigure_Click()
# Line 201 | Line 226 | End Sub
226   Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
227  
228      Form1.Visible = True
204    SystemTray.Action = 2
229      Form1.SetFocus
230      
231  
# Line 328 | 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 <        localIP = TCPSock.localIP
333 <        machineName = TCPSock.LocalHostName
355 >        
356 >        ' prepare the contents of the XML packet.
357          seqNo = seqNo + 1
358 <        packetDate = Now()
359 <        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _
360 <              "" & _
361 <              "" & _
362 <              "" & _
363 <              "" & _
364 <              "" & _
365 <              "" & _
366 <              "" & _
367 <              "" & _
368 <              "" & _
369 <              "" & _
370 <              "" & _
371 <              "" & _
372 <              "" & _
373 <              "" & _
374 <              ""
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.
# Line 369 | Line 438 | Private Sub Timer1_Timer()
438   End Sub
439  
440   Function Date2Num() As Long
441 <    Date2Num = DateDiff("s", "1-1-1970", Now)
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