host/vb_net_test/nettest.frm

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{33155A3D-0CE0-11D1-A6B4-444553540000}#1.0#0"; "SysTray.ocx"
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "i-scream Winhost"
   ClientHeight    =   1275
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4710
   Icon            =   "nettest.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1275
   ScaleWidth      =   4710
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Visible         =   0   'False
   Begin VB.CommandButton Hide 
      Caption         =   "Hide Window"
      Height          =   375
      Left            =   3120
      TabIndex        =   6
      Top             =   480
      Width           =   1455
   End
   Begin SysTray.SystemTray SystemTray 
      Left            =   2160
      Top             =   1800
      _ExtentX        =   847
      _ExtentY        =   847
      SysTrayText     =   "i-scream Winhost"
      IconFile        =   0
   End
   Begin VB.Timer Timer1 
      Left            =   2760
      Top             =   1800
   End
   Begin VB.CommandButton Reconfigure 
      Caption         =   "Reconfigure with FilterManager"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   2895
   End
   Begin MSWinsockLib.Winsock TCPSock 
      Left            =   3720
      Top             =   1800
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock UDPSock 
      Left            =   3240
      Top             =   1800
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      Caption         =   "Next heartbeat:"
      Height          =   255
      Left            =   2400
      TabIndex        =   5
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Next UDP packet:"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label4 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   3960
      TabIndex        =   3
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label3 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   1680
      TabIndex        =   2
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Status 
      Alignment       =   2  'Center
      Caption         =   "Status:"
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   960
      Width           =   4695
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' For the system tray bits
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
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

Dim filterManagerHostname As String
Dim filterManagerTCPPort As Long

Dim seqNo As Long
Dim machineName As String

Dim filterHostname As String
Dim filterTCPPort As Integer
Dim filterUDPPort As Integer
Dim fileList As String
Dim lastModified As String

Dim UDPUpdateTime As Integer
Dim TCPUpdateTime As Integer

Dim protocolVersion As String
Dim connected As Boolean

Dim CUpTime As New CUpTime
Dim wksta As New CNetWksta

Dim responseNumber As Integer

Private Sub Form_Load()
    
    If App.PrevInstance Then
        x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
        End
    End If
    
    protocolVersion = "1.1"
    
    Status.Caption = "Loading"
    Form1.Caption = "i-scream Winhost " & protocolVersion
    
    CUpTime.Init
    
    If CUpTime.isWin9x Then
        x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
        End
    End If
    
    ''''TEMP
    'filterManagerHostname = "killigrew.ukc.ac.uk"
    'filterManagerTCPPort = 4567
    ''''' END TEMP
    
    'GoTo skip
    On Error GoTo iniError
    Dim buf As String * 256
    Dim length As Long
    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
    filterManagerHostname = Left$(buf, length)
    length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
    filterManagerTCPPort = length
    If filterManagerHostname = "" Then
        GoTo iniError
    End If
    On Error GoTo 0
skip:

    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
    Reconfigure_Click
    
    SystemTray.Icon = Val(Form1.Icon)
    SystemTray.Action = 0
    
    
    Exit Sub
    
iniError:
    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")
    End
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    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")
    If x = 7 Then
        Cancel = True
    Else
        SystemTray.Action = 2
    End If

End Sub

Private Sub Hide_Click()
    Form1.Visible = False
    SystemTray.Icon = Val(Form1.Icon)
End Sub

Private Sub Reconfigure_Click()
    ' establish a TCP connection to a filtermanager
    connected = False
    TCPSock.Close
    TCPSock.Connect filterManagerHostname, filterManagerTCPPort
End Sub


Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)

    Form1.Visible = True
    Form1.SetFocus

End Sub

Private Sub TCPSock_Connect()
    
    responseNumber = 0
   
    ' Send something as soon as we connect to the server.
    If connected = False Then
        ' contact the FilterManager
        TCPSock.SendData "STARTCONFIG" & vbCrLf
    Else
       ' Contact the Filter
       TCPSock.SendData "HEARTBEAT" & vbCrLf
    End If
   
End Sub

Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
    
    responseNumber = responseNumber + 1
    
    ' Get the line from the server.
    TCPSock.GetData response, vbString, bytesTotal
    
    ' Remove linefeeds and returns from the line.
    response = Replace(response, Chr(13), "")
    response = Replace(response, Chr(10), "")
    'Text4.Text = Text4.Text & vbCrLf & response
    
    If connected = False Then
        ' Perform TCP configuration (1.1)
        On Error GoTo configError
        Select Case responseNumber
            Case 1:
                If Not response = "OK" Then GoTo configError
                TCPSock.SendData "LASTMODIFIED" & vbCrLf
            Case 2:
                If response = "ERROR" Then GoTo configError
                lastModified = response
                TCPSock.SendData "FILELIST" & vbCrLf
            Case 3:
                If response = "ERROR" Then GoTo configError
                fileList = response
                TCPSock.SendData "UDPUpdateTime" & vbCrLf
            Case 4:
                If response = "ERROR" Then GoTo configError
                UDPUpdateTime = response
                TCPSock.SendData "TCPUpdateTime" & vbCrLf
            Case 5:
                If response = "ERROR" Then GoTo configError
                TCPUpdateTime = response
                TCPSock.SendData "ENDCONFIG" & vbCrLf
            Case 6:
                If Not response = "OK" Then GoTo configError
                TCPSock.SendData "FILTER" & vbCrLf
            Case 7:
                'we got a filter list here.
                readTo = 0
                ' get hostname
                readTo = InStr(1, response, ";", vbBinaryCompare)
                filterHostname = Mid(response, 1, readTo - 1)
                response = Mid(response, readTo + 1, Len(response))
                ' get UDP Port number
                readTo = InStr(1, response, ";")
                filterUDPPort = Mid(response, 1, readTo - 1)
                response = Mid(response, readTo + 1, Len(response))
                ' get TCP Port number
                filterTCPPort = response
                TCPSock.SendData "END" & vbCrLf
            Case 8:
                If Not response = "OK" Then GoTo configError
                connected = True
                responseNumber = 0
                TCPSock.Close
                'Text4.Text = Text4.Text & vbCrLf & "  <closed>"
                Status.Caption = "Configuration successful"
                Label3.Caption = UDPUpdateTime
                Label4.Caption = TCPUpdateTime
                Timer1.Interval = 1000
        End Select
    Else
        ' Perform a heartbeat (1.1)
        On Error GoTo heartbeatError
        Select Case responseNumber
            Case 1:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData "CONFIG" & vbCrLf
            Case 2:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData fileList & vbCrLf
            Case 3:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData lastModified & vbCrLf
            Case 4:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
            Case 5:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.Close
                Status.Caption = "Heartbeat sent successfully."
        End Select
    
    End If
    
    
    Exit Sub
    
configError:
    Status.Caption = "FAILED to get configuration"
    Exit Sub
heartbeatError:
    Status.Caption = "Heatbeat FAILED"
    Exit Sub
End Sub

Private Sub Timer1_Timer()

    Label3.Caption = Label3.Caption - 1
    Label4.Caption = Label4.Caption - 1
    
    Status.Caption = ""
    
    If Label3.Caption < 1 Then
        
        ' prepare the contents of the XML packet.
        seqNo = seqNo + 1
        machineName = TCPSock.LocalHostName
        LocalIP = TCPSock.LocalIP
        packetDate = Date2Num()
        
        
        Dim verinfo As OSVERSIONINFO
        verinfo.dwOSVersionInfoSize = Len(verinfo)
        ret% = GetVersionEx(verinfo)
        If ret% = 0 Then
            MsgBox "Error getting Windows version Information"
            End
        End If
          
        osName = GetVersion()
        osVersionMajor = verinfo.dwMajorVersion
        osVersionMinor = verinfo.dwMinorVersion
        osBuild = verinfo.dwBuildNumber
        
        Dim sysinfo As SYSTEM_INFO
        GetSystemInfo sysinfo
        Select Case sysinfo.dwProcessorType
            Case PROCESSOR_INTEL_386
                processorType = "Intel 386"
            Case PROCESSOR_INTEL_486
                processorType = "Intel 486"
            Case PROCESSOR_INTEL_PENTIUM
                processorType = "Intel Pentium variant"
            Case PROCESSOR_MIPS_R4000
                processorType = "MIPS R4000"
            Case PROCESSOR_ALPHA_21064
                processorType = "DEC Alpha 21064"
            Case Else
                processorType = "(unknown)"
        End Select
        
        Dim memsts As MEMORYSTATUS
        Dim memory&
        GlobalMemoryStatus memsts
        memory& = memsts.dwTotalPhys
        memTotal = memory& \ 1024
        memory& = memsts.dwAvailPhys
        memFree = memory& \ 1024
        memory& = memsts.dwTotalVirtual
        swapTotal = memory& \ 1024
        memory& = memsts.dwAvailVirtual
        swapFree = memory& \ 1024
        
        uptime = CUpTime.MilliSecs \ 1000
        
        CUpTime.Capture
        cpu_time = CUpTime.CPUTime
        percent_idle = CUpTime.PercentIdle
        
        ' build the contents of the XML packet
        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
              "<os>" & _
                "<name>" & osName & "</name>" & _
                "<version>" & osVersionMajor & "</version>" & _
                "<release>" & osBuild & "</release>" & _
                "<platform>" & osName & "</platform>" & _
                "<minor_version>" & osVersionMinor & "</minor_version>" & _
                "<processor>" & processorType & "</processor>" & _
                "<uptime>" & uptime & "</uptime>" & _
              "</os>" & _
              "<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
              "<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
              "<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
              "</packet>"
        'Text4.Text = Text4.Text + xml

        ' Use the first winsock control to send a UDP packet.
        UDPSock.RemoteHost = filterHostname
        UDPSock.RemotePort = filterUDPPort
        UDPSock.SendData xml
        Status.Caption = "UDP packet sent"
        Label3.Caption = UDPUpdateTime
    End If
    
    If Label4.Caption < 1 Then
        ' establish a TCP connection to a filter
        TCPSock.Close
        TCPSock.Connect filterHostname, filterTCPPort
        Label4.Caption = TCPUpdateTime
    End If

End Sub

Function Date2Num() As Long
    Dim x As Long
    x = DateDiff("s", "1-1-1970", Now)
    Date2Num = x
End Function
Revision:	1.25
Committed:	Wed Feb 28 08:19:00 2001 UTC (23 years, 8 months ago) by pjm2
Branch:	MAIN
Changes since 1.24:	+7 -2 lines
Log Message:	Uptime is now obtained from the CUpTime class rather than the Windows API. This should hopefully prevent the number wrapping round after 47 days.
#	User	Rev	Content
1	pjm2	1.1	VERSION 5.00
2			Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
3	pjm2	1.11	Object = "{33155A3D-0CE0-11D1-A6B4-444553540000}#1.0#0"; "SysTray.ocx"
4	pjm2	1.1	Begin VB.Form Form1
5	pjm2	1.17	BorderStyle = 3 'Fixed Dialog
6	pjm2	1.10	Caption = "i-scream Winhost"
7	pjm2	1.24	ClientHeight = 1275
8	pjm2	1.1	ClientLeft = 45
9	pjm2	1.17	ClientTop = 330
10	pjm2	1.12	ClientWidth = 4710
11	pjm2	1.20	Icon = "nettest.frx":0000
12	pjm2	1.1	LinkTopic = "Form1"
13			MaxButton = 0 'False
14	pjm2	1.17	MinButton = 0 'False
15	pjm2	1.24	ScaleHeight = 1275
16	pjm2	1.12	ScaleWidth = 4710
17	pjm2	1.1	ShowInTaskbar = 0 'False
18	pjm2	1.24	StartUpPosition = 2 'CenterScreen
19			Visible = 0 'False
20	pjm2	1.11	Begin VB.CommandButton Hide
21	pjm2	1.12	Caption = "Hide Window"
22			Height = 375
23			Left = 3120
24	pjm2	1.24	TabIndex = 6
25			Top = 480
26	pjm2	1.12	Width = 1455
27	pjm2	1.11	End
28			Begin SysTray.SystemTray SystemTray
29	pjm2	1.12	Left = 2160
30			Top = 1800
31	pjm2	1.11	_ExtentX = 847
32			_ExtentY = 847
33			SysTrayText = "i-scream Winhost"
34			IconFile = 0
35			End
36	pjm2	1.8	Begin VB.Timer Timer1
37	pjm2	1.12	Left = 2760
38			Top = 1800
39	pjm2	1.1	End
40	pjm2	1.10	Begin VB.CommandButton Reconfigure
41			Caption = "Reconfigure with FilterManager"
42	pjm2	1.12	Height = 375
43	pjm2	1.10	Left = 120
44			TabIndex = 0
45	pjm2	1.24	Top = 480
46	pjm2	1.10	Width = 2895
47	pjm2	1.1	End
48	pjm2	1.5	Begin MSWinsockLib.Winsock TCPSock
49	pjm2	1.12	Left = 3720
50			Top = 1800
51	pjm2	1.1	_ExtentX = 741
52			_ExtentY = 741
53			_Version = 393216
54			End
55	pjm2	1.5	Begin MSWinsockLib.Winsock UDPSock
56	pjm2	1.12	Left = 3240
57			Top = 1800
58	pjm2	1.1	_ExtentX = 741
59			_ExtentY = 741
60			_Version = 393216
61			Protocol = 1
62			End
63	pjm2	1.9	Begin VB.Label Label2
64			Alignment = 1 'Right Justify
65			Caption = "Next heartbeat:"
66	pjm2	1.8	Height = 255
67	pjm2	1.12	Left = 2400
68	pjm2	1.24	TabIndex = 5
69			Top = 120
70	pjm2	1.9	Width = 1455
71	pjm2	1.8	End
72	pjm2	1.9	Begin VB.Label Label1
73			Alignment = 1 'Right Justify
74			Caption = "Next UDP packet:"
75	pjm2	1.8	Height = 255
76	pjm2	1.24	Left = 120
77			TabIndex = 4
78	pjm2	1.9	Top = 120
79			Width = 1455
80	pjm2	1.8	End
81	pjm2	1.9	Begin VB.Label Label4
82	pjm2	1.10	BorderStyle = 1 'Fixed Single
83	pjm2	1.9	Caption = "0"
84	pjm2	1.7	Height = 255
85	pjm2	1.12	Left = 3960
86	pjm2	1.24	TabIndex = 3
87			Top = 120
88	pjm2	1.9	Width = 615
89	pjm2	1.7	End
90	pjm2	1.9	Begin VB.Label Label3
91	pjm2	1.10	BorderStyle = 1 'Fixed Single
92	pjm2	1.9	Caption = "0"
93	pjm2	1.7	Height = 255
94	pjm2	1.24	Left = 1680
95			TabIndex = 2
96	pjm2	1.9	Top = 120
97			Width = 615
98	pjm2	1.7	End
99	pjm2	1.6	Begin VB.Label Status
100	pjm2	1.12	Alignment = 2 'Center
101	pjm2	1.6	Caption = "Status:"
102	pjm2	1.1	Height = 255
103	pjm2	1.18	Left = 0
104	pjm2	1.24	TabIndex = 1
105			Top = 960
106	pjm2	1.18	Width = 4695
107	pjm2	1.1	End
108			End
109			Attribute VB_Name = "Form1"
110			Attribute VB_GlobalNameSpace = False
111			Attribute VB_Creatable = False
112			Attribute VB_PredeclaredId = True
113			Attribute VB_Exposed = False
114	pjm2	1.15	' For the system tray bits
115	pjm2	1.4	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
116			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
117
118			Dim filterManagerHostname As String
119	pjm2	1.18	Dim filterManagerTCPPort As Long
120	pjm2	1.4
121	pjm2	1.13	Dim seqNo As Long
122			Dim machineName As String
123
124	pjm2	1.2	Dim filterHostname As String
125	pjm2	1.3	Dim filterTCPPort As Integer
126			Dim filterUDPPort As Integer
127			Dim fileList As String
128			Dim lastModified As String
129	pjm2	1.2
130	pjm2	1.7	Dim UDPUpdateTime As Integer
131			Dim TCPUpdateTime As Integer
132
133	pjm2	1.2	Dim protocolVersion As String
134			Dim connected As Boolean
135	pjm2	1.16
136	pjm2	1.21	Dim CUpTime As New CUpTime
137	pjm2	1.25	Dim wksta As New CNetWksta
138	pjm2	1.16
139	pjm2	1.1	Dim responseNumber As Integer
140
141	pjm2	1.2	Private Sub Form_Load()
142	pjm2	1.13
143	pjm2	1.22	If App.PrevInstance Then
144			x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
145	pjm2	1.25	End
146	pjm2	1.22	End If
147
148	pjm2	1.2	protocolVersion = "1.1"
149	pjm2	1.13
150	pjm2	1.10	Status.Caption = "Loading"
151	pjm2	1.21	Form1.Caption = "i-scream Winhost " & protocolVersion
152
153			CUpTime.Init
154
155			If CUpTime.isWin9x Then
156	pjm2	1.25	x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
157	pjm2	1.21	End
158			End If
159	pjm2	1.6
160	pjm2	1.4	''''TEMP
161	pjm2	1.18	'filterManagerHostname = "killigrew.ukc.ac.uk"
162			'filterManagerTCPPort = 4567
163	pjm2	1.13	''''' END TEMP
164	pjm2	1.4
165	pjm2	1.18	'GoTo skip
166	pjm2	1.4	On Error GoTo iniError
167			Dim buf As String * 256
168			Dim length As Long
169	pjm2	1.18	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
170	pjm2	1.4	filterManagerHostname = Left$(buf, length)
171	pjm2	1.18	length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
172			filterManagerTCPPort = length
173	pjm2	1.25	If filterManagerHostname = "" Then
174			GoTo iniError
175			End If
176	pjm2	1.20	On Error GoTo 0
177	pjm2	1.13	skip:
178
179	pjm2	1.18	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
180	pjm2	1.13	Reconfigure_Click
181	pjm2	1.6
182	pjm2	1.20	SystemTray.Icon = Val(Form1.Icon)
183	pjm2	1.15	SystemTray.Action = 0
184
185
186	pjm2	1.4	Exit Sub
187
188			iniError:
189	pjm2	1.18	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")
190	pjm2	1.4	End
191
192			End Sub
193
194	pjm2	1.10	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
195	pjm2	1.11	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")
196	pjm2	1.10	If x = 7 Then
197			Cancel = True
198	pjm2	1.15	Else
199			SystemTray.Action = 2
200	pjm2	1.10	End If
201
202			End Sub
203
204	pjm2	1.11	Private Sub Hide_Click()
205			Form1.Visible = False
206			SystemTray.Icon = Val(Form1.Icon)
207			End Sub
208
209	pjm2	1.10	Private Sub Reconfigure_Click()
210			' establish a TCP connection to a filtermanager
211			connected = False
212			TCPSock.Close
213			TCPSock.Connect filterManagerHostname, filterManagerTCPPort
214	pjm2	1.11	End Sub
215
216
217
218			Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
219
220			Form1.Visible = True
221			Form1.SetFocus
222
223	pjm2	1.10	End Sub
224
225	pjm2	1.5	Private Sub TCPSock_Connect()
226	pjm2	1.6
227			responseNumber = 0
228	pjm2	1.1
229	pjm2	1.3	' Send something as soon as we connect to the server.
230			If connected = False Then
231			' contact the FilterManager
232	pjm2	1.5	TCPSock.SendData "STARTCONFIG" & vbCrLf
233	pjm2	1.3	Else
234			' Contact the Filter
235	pjm2	1.5	TCPSock.SendData "HEARTBEAT" & vbCrLf
236	pjm2	1.3	End If
237	pjm2	1.1
238			End Sub
239
240	pjm2	1.5	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
241	pjm2	1.1
242			responseNumber = responseNumber + 1
243
244			' Get the line from the server.
245	pjm2	1.5	TCPSock.GetData response, vbString, bytesTotal
246	pjm2	1.1
247			' Remove linefeeds and returns from the line.
248			response = Replace(response, Chr(13), "")
249			response = Replace(response, Chr(10), "")
250	pjm2	1.24	'Text4.Text = Text4.Text & vbCrLf & response
251	pjm2	1.1
252	pjm2	1.2	If connected = False Then
253			' Perform TCP configuration (1.1)
254			On Error GoTo configError
255			Select Case responseNumber
256			Case 1:
257			If Not response = "OK" Then GoTo configError
258	pjm2	1.5	TCPSock.SendData "LASTMODIFIED" & vbCrLf
259	pjm2	1.2	Case 2:
260			If response = "ERROR" Then GoTo configError
261	pjm2	1.3	lastModified = response
262	pjm2	1.5	TCPSock.SendData "FILELIST" & vbCrLf
263	pjm2	1.2	Case 3:
264			If response = "ERROR" Then GoTo configError
265	pjm2	1.3	fileList = response
266	pjm2	1.5	TCPSock.SendData "UDPUpdateTime" & vbCrLf
267	pjm2	1.2	Case 4:
268			If response = "ERROR" Then GoTo configError
269	pjm2	1.7	UDPUpdateTime = response
270	pjm2	1.5	TCPSock.SendData "TCPUpdateTime" & vbCrLf
271	pjm2	1.2	Case 5:
272			If response = "ERROR" Then GoTo configError
273	pjm2	1.7	TCPUpdateTime = response
274	pjm2	1.5	TCPSock.SendData "ENDCONFIG" & vbCrLf
275	pjm2	1.2	Case 6:
276			If Not response = "OK" Then GoTo configError
277	pjm2	1.5	TCPSock.SendData "FILTER" & vbCrLf
278	pjm2	1.2	Case 7:
279			'we got a filter list here.
280			readTo = 0
281			' get hostname
282			readTo = InStr(1, response, ";", vbBinaryCompare)
283			filterHostname = Mid(response, 1, readTo - 1)
284			response = Mid(response, readTo + 1, Len(response))
285			' get UDP Port number
286			readTo = InStr(1, response, ";")
287			filterUDPPort = Mid(response, 1, readTo - 1)
288			response = Mid(response, readTo + 1, Len(response))
289			' get TCP Port number
290			filterTCPPort = response
291	pjm2	1.5	TCPSock.SendData "END" & vbCrLf
292	pjm2	1.2	Case 8:
293			If Not response = "OK" Then GoTo configError
294			connected = True
295			responseNumber = 0
296	pjm2	1.5	TCPSock.Close
297	pjm2	1.24	'Text4.Text = Text4.Text & vbCrLf & " <closed>"
298	pjm2	1.10	Status.Caption = "Configuration successful"
299	pjm2	1.8	Label3.Caption = UDPUpdateTime
300			Label4.Caption = TCPUpdateTime
301			Timer1.Interval = 1000
302	pjm2	1.2	End Select
303			Else
304			' Perform a heartbeat (1.1)
305			On Error GoTo heartbeatError
306			Select Case responseNumber
307			Case 1:
308	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
309	pjm2	1.5	TCPSock.SendData "CONFIG" & vbCrLf
310	pjm2	1.2	Case 2:
311	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
312	pjm2	1.5	TCPSock.SendData fileList & vbCrLf
313	pjm2	1.2	Case 3:
314	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
315	pjm2	1.5	TCPSock.SendData lastModified & vbCrLf
316	pjm2	1.2	Case 4:
317	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
318	pjm2	1.5	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
319	pjm2	1.2	Case 5:
320	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
321	pjm2	1.5	TCPSock.Close
322	pjm2	1.10	Status.Caption = "Heartbeat sent successfully."
323	pjm2	1.2	End Select
324
325			End If
326
327
328			Exit Sub
329
330			configError:
331	pjm2	1.10	Status.Caption = "FAILED to get configuration"
332	pjm2	1.8	Exit Sub
333	pjm2	1.2	heartbeatError:
334	pjm2	1.10	Status.Caption = "Heatbeat FAILED"
335	pjm2	1.8	Exit Sub
336	pjm2	1.1	End Sub
337	pjm2	1.5
338	pjm2	1.8	Private Sub Timer1_Timer()
339
340			Label3.Caption = Label3.Caption - 1
341			Label4.Caption = Label4.Caption - 1
342
343	pjm2	1.10	Status.Caption = ""
344	pjm2	1.8
345			If Label3.Caption < 1 Then
346	pjm2	1.15
347			' prepare the contents of the XML packet.
348			seqNo = seqNo + 1
349			machineName = TCPSock.LocalHostName
350	pjm2	1.16	LocalIP = TCPSock.LocalIP
351	pjm2	1.14	packetDate = Date2Num()
352	pjm2	1.15
353
354			Dim verinfo As OSVERSIONINFO
355			verinfo.dwOSVersionInfoSize = Len(verinfo)
356			ret% = GetVersionEx(verinfo)
357			If ret% = 0 Then
358			MsgBox "Error getting Windows version Information"
359			End
360			End If
361
362	pjm2	1.21	osName = GetVersion()
363	pjm2	1.15	osVersionMajor = verinfo.dwMajorVersion
364			osVersionMinor = verinfo.dwMinorVersion
365			osBuild = verinfo.dwBuildNumber
366
367			Dim sysinfo As SYSTEM_INFO
368			GetSystemInfo sysinfo
369			Select Case sysinfo.dwProcessorType
370			Case PROCESSOR_INTEL_386
371			processorType = "Intel 386"
372			Case PROCESSOR_INTEL_486
373			processorType = "Intel 486"
374			Case PROCESSOR_INTEL_PENTIUM
375			processorType = "Intel Pentium variant"
376			Case PROCESSOR_MIPS_R4000
377			processorType = "MIPS R4000"
378			Case PROCESSOR_ALPHA_21064
379			processorType = "DEC Alpha 21064"
380			Case Else
381			processorType = "(unknown)"
382			End Select
383
384			Dim memsts As MEMORYSTATUS
385			Dim memory&
386			GlobalMemoryStatus memsts
387			memory& = memsts.dwTotalPhys
388			memTotal = memory& \ 1024
389			memory& = memsts.dwAvailPhys
390			memFree = memory& \ 1024
391			memory& = memsts.dwTotalVirtual
392			swapTotal = memory& \ 1024
393			memory& = memsts.dwAvailVirtual
394			swapFree = memory& \ 1024
395
396	pjm2	1.25	uptime = CUpTime.MilliSecs \ 1000
397	pjm2	1.19
398	pjm2	1.23	CUpTime.Capture
399			cpu_time = CUpTime.CPUTime
400			percent_idle = CUpTime.PercentIdle
401
402	pjm2	1.15	' build the contents of the XML packet
403	pjm2	1.16	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
404	pjm2	1.15	"<os>" & _
405			"<name>" & osName & "</name>" & _
406			"<version>" & osVersionMajor & "</version>" & _
407			"<release>" & osBuild & "</release>" & _
408			"<platform>" & osName & "</platform>" & _
409			"<minor_version>" & osVersionMinor & "</minor_version>" & _
410			"<processor>" & processorType & "</processor>" & _
411	pjm2	1.19	"<uptime>" & uptime & "</uptime>" & _
412	pjm2	1.15	"</os>" & _
413	pjm2	1.23	"<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
414	pjm2	1.15	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
415			"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
416	pjm2	1.17	"</packet>"
417	pjm2	1.24	'Text4.Text = Text4.Text + xml
418	pjm2	1.8
419			' Use the first winsock control to send a UDP packet.
420			UDPSock.RemoteHost = filterHostname
421			UDPSock.RemotePort = filterUDPPort
422			UDPSock.SendData xml
423	pjm2	1.10	Status.Caption = "UDP packet sent"
424	pjm2	1.8	Label3.Caption = UDPUpdateTime
425			End If
426
427			If Label4.Caption < 1 Then
428			' establish a TCP connection to a filter
429			TCPSock.Close
430			TCPSock.Connect filterHostname, filterTCPPort
431			Label4.Caption = TCPUpdateTime
432			End If
433
434			End Sub
435	pjm2	1.13
436			Function Date2Num() As Long
437	pjm2	1.14	Dim x As Long
438			x = DateDiff("s", "1-1-1970", Now)
439			Date2Num = x
440	pjm2	1.13	End Function