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 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 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
    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 = GetTickCount \ 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.24
Committed:	Mon Feb 26 10:13:10 2001 UTC (23 years, 8 months ago) by pjm2
Branch:	MAIN
Changes since 1.23:	+20 -49 lines
Log Message:	Program now starts up minimised in the system tray. I think this is more or less the final thing now.
#	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.16
138	pjm2	1.1	Dim responseNumber As Integer
139
140	pjm2	1.2	Private Sub Form_Load()
141	pjm2	1.13
142	pjm2	1.22	If App.PrevInstance Then
143			x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
144			End If
145
146	pjm2	1.2	protocolVersion = "1.1"
147	pjm2	1.13
148	pjm2	1.10	Status.Caption = "Loading"
149	pjm2	1.21	Form1.Caption = "i-scream Winhost " & protocolVersion
150
151			CUpTime.Init
152
153			If CUpTime.isWin9x Then
154			x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server.")
155			End
156			End If
157	pjm2	1.6
158	pjm2	1.4	''''TEMP
159	pjm2	1.18	'filterManagerHostname = "killigrew.ukc.ac.uk"
160			'filterManagerTCPPort = 4567
161	pjm2	1.13	''''' END TEMP
162	pjm2	1.4
163	pjm2	1.18	'GoTo skip
164	pjm2	1.4	On Error GoTo iniError
165			Dim buf As String * 256
166			Dim length As Long
167	pjm2	1.18	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
168	pjm2	1.4	filterManagerHostname = Left$(buf, length)
169	pjm2	1.18	length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
170			filterManagerTCPPort = length
171	pjm2	1.20	On Error GoTo 0
172	pjm2	1.13	skip:
173
174	pjm2	1.18	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
175	pjm2	1.13	Reconfigure_Click
176	pjm2	1.6
177	pjm2	1.20	SystemTray.Icon = Val(Form1.Icon)
178	pjm2	1.15	SystemTray.Action = 0
179
180
181	pjm2	1.4	Exit Sub
182
183			iniError:
184	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")
185	pjm2	1.4	End
186
187			End Sub
188
189	pjm2	1.10	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
190	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")
191	pjm2	1.10	If x = 7 Then
192			Cancel = True
193	pjm2	1.15	Else
194			SystemTray.Action = 2
195	pjm2	1.10	End If
196
197			End Sub
198
199	pjm2	1.11	Private Sub Hide_Click()
200			Form1.Visible = False
201			SystemTray.Icon = Val(Form1.Icon)
202			End Sub
203
204	pjm2	1.10	Private Sub Reconfigure_Click()
205			' establish a TCP connection to a filtermanager
206			connected = False
207			TCPSock.Close
208			TCPSock.Connect filterManagerHostname, filterManagerTCPPort
209	pjm2	1.11	End Sub
210
211
212
213			Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
214
215			Form1.Visible = True
216			Form1.SetFocus
217
218	pjm2	1.10	End Sub
219
220	pjm2	1.5	Private Sub TCPSock_Connect()
221	pjm2	1.6
222			responseNumber = 0
223	pjm2	1.1
224	pjm2	1.3	' Send something as soon as we connect to the server.
225			If connected = False Then
226			' contact the FilterManager
227	pjm2	1.5	TCPSock.SendData "STARTCONFIG" & vbCrLf
228	pjm2	1.3	Else
229			' Contact the Filter
230	pjm2	1.5	TCPSock.SendData "HEARTBEAT" & vbCrLf
231	pjm2	1.3	End If
232	pjm2	1.1
233			End Sub
234
235	pjm2	1.5	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
236	pjm2	1.1
237			responseNumber = responseNumber + 1
238
239			' Get the line from the server.
240	pjm2	1.5	TCPSock.GetData response, vbString, bytesTotal
241	pjm2	1.1
242			' Remove linefeeds and returns from the line.
243			response = Replace(response, Chr(13), "")
244			response = Replace(response, Chr(10), "")
245	pjm2	1.24	'Text4.Text = Text4.Text & vbCrLf & response
246	pjm2	1.1
247	pjm2	1.2	If connected = False Then
248			' Perform TCP configuration (1.1)
249			On Error GoTo configError
250			Select Case responseNumber
251			Case 1:
252			If Not response = "OK" Then GoTo configError
253	pjm2	1.5	TCPSock.SendData "LASTMODIFIED" & vbCrLf
254	pjm2	1.2	Case 2:
255			If response = "ERROR" Then GoTo configError
256	pjm2	1.3	lastModified = response
257	pjm2	1.5	TCPSock.SendData "FILELIST" & vbCrLf
258	pjm2	1.2	Case 3:
259			If response = "ERROR" Then GoTo configError
260	pjm2	1.3	fileList = response
261	pjm2	1.5	TCPSock.SendData "UDPUpdateTime" & vbCrLf
262	pjm2	1.2	Case 4:
263			If response = "ERROR" Then GoTo configError
264	pjm2	1.7	UDPUpdateTime = response
265	pjm2	1.5	TCPSock.SendData "TCPUpdateTime" & vbCrLf
266	pjm2	1.2	Case 5:
267			If response = "ERROR" Then GoTo configError
268	pjm2	1.7	TCPUpdateTime = response
269	pjm2	1.5	TCPSock.SendData "ENDCONFIG" & vbCrLf
270	pjm2	1.2	Case 6:
271			If Not response = "OK" Then GoTo configError
272	pjm2	1.5	TCPSock.SendData "FILTER" & vbCrLf
273	pjm2	1.2	Case 7:
274			'we got a filter list here.
275			readTo = 0
276			' get hostname
277			readTo = InStr(1, response, ";", vbBinaryCompare)
278			filterHostname = Mid(response, 1, readTo - 1)
279			response = Mid(response, readTo + 1, Len(response))
280			' get UDP Port number
281			readTo = InStr(1, response, ";")
282			filterUDPPort = Mid(response, 1, readTo - 1)
283			response = Mid(response, readTo + 1, Len(response))
284			' get TCP Port number
285			filterTCPPort = response
286	pjm2	1.5	TCPSock.SendData "END" & vbCrLf
287	pjm2	1.2	Case 8:
288			If Not response = "OK" Then GoTo configError
289			connected = True
290			responseNumber = 0
291	pjm2	1.5	TCPSock.Close
292	pjm2	1.24	'Text4.Text = Text4.Text & vbCrLf & " <closed>"
293	pjm2	1.10	Status.Caption = "Configuration successful"
294	pjm2	1.8	Label3.Caption = UDPUpdateTime
295			Label4.Caption = TCPUpdateTime
296			Timer1.Interval = 1000
297	pjm2	1.2	End Select
298			Else
299			' Perform a heartbeat (1.1)
300			On Error GoTo heartbeatError
301			Select Case responseNumber
302			Case 1:
303	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
304	pjm2	1.5	TCPSock.SendData "CONFIG" & vbCrLf
305	pjm2	1.2	Case 2:
306	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
307	pjm2	1.5	TCPSock.SendData fileList & vbCrLf
308	pjm2	1.2	Case 3:
309	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
310	pjm2	1.5	TCPSock.SendData lastModified & vbCrLf
311	pjm2	1.2	Case 4:
312	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
313	pjm2	1.5	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
314	pjm2	1.2	Case 5:
315	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
316	pjm2	1.5	TCPSock.Close
317	pjm2	1.10	Status.Caption = "Heartbeat sent successfully."
318	pjm2	1.2	End Select
319
320			End If
321
322
323			Exit Sub
324
325			configError:
326	pjm2	1.10	Status.Caption = "FAILED to get configuration"
327	pjm2	1.8	Exit Sub
328	pjm2	1.2	heartbeatError:
329	pjm2	1.10	Status.Caption = "Heatbeat FAILED"
330	pjm2	1.8	Exit Sub
331	pjm2	1.1	End Sub
332	pjm2	1.5
333	pjm2	1.8	Private Sub Timer1_Timer()
334
335			Label3.Caption = Label3.Caption - 1
336			Label4.Caption = Label4.Caption - 1
337
338	pjm2	1.10	Status.Caption = ""
339	pjm2	1.8
340			If Label3.Caption < 1 Then
341	pjm2	1.15
342			' prepare the contents of the XML packet.
343			seqNo = seqNo + 1
344			machineName = TCPSock.LocalHostName
345	pjm2	1.16	LocalIP = TCPSock.LocalIP
346	pjm2	1.14	packetDate = Date2Num()
347	pjm2	1.15
348
349			Dim verinfo As OSVERSIONINFO
350			verinfo.dwOSVersionInfoSize = Len(verinfo)
351			ret% = GetVersionEx(verinfo)
352			If ret% = 0 Then
353			MsgBox "Error getting Windows version Information"
354			End
355			End If
356
357	pjm2	1.21	osName = GetVersion()
358	pjm2	1.15	osVersionMajor = verinfo.dwMajorVersion
359			osVersionMinor = verinfo.dwMinorVersion
360			osBuild = verinfo.dwBuildNumber
361
362			Dim sysinfo As SYSTEM_INFO
363			GetSystemInfo sysinfo
364			Select Case sysinfo.dwProcessorType
365			Case PROCESSOR_INTEL_386
366			processorType = "Intel 386"
367			Case PROCESSOR_INTEL_486
368			processorType = "Intel 486"
369			Case PROCESSOR_INTEL_PENTIUM
370			processorType = "Intel Pentium variant"
371			Case PROCESSOR_MIPS_R4000
372			processorType = "MIPS R4000"
373			Case PROCESSOR_ALPHA_21064
374			processorType = "DEC Alpha 21064"
375			Case Else
376			processorType = "(unknown)"
377			End Select
378
379			Dim memsts As MEMORYSTATUS
380			Dim memory&
381			GlobalMemoryStatus memsts
382			memory& = memsts.dwTotalPhys
383			memTotal = memory& \ 1024
384			memory& = memsts.dwAvailPhys
385			memFree = memory& \ 1024
386			memory& = memsts.dwTotalVirtual
387			swapTotal = memory& \ 1024
388			memory& = memsts.dwAvailVirtual
389			swapFree = memory& \ 1024
390
391	pjm2	1.19	uptime = GetTickCount \ 1000
392
393	pjm2	1.23	CUpTime.Capture
394			cpu_time = CUpTime.CPUTime
395			percent_idle = CUpTime.PercentIdle
396
397	pjm2	1.15	' build the contents of the XML packet
398	pjm2	1.16	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
399	pjm2	1.15	"<os>" & _
400			"<name>" & osName & "</name>" & _
401			"<version>" & osVersionMajor & "</version>" & _
402			"<release>" & osBuild & "</release>" & _
403			"<platform>" & osName & "</platform>" & _
404			"<minor_version>" & osVersionMinor & "</minor_version>" & _
405			"<processor>" & processorType & "</processor>" & _
406	pjm2	1.19	"<uptime>" & uptime & "</uptime>" & _
407	pjm2	1.15	"</os>" & _
408	pjm2	1.23	"<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
409	pjm2	1.15	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
410			"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
411	pjm2	1.17	"</packet>"
412	pjm2	1.24	'Text4.Text = Text4.Text + xml
413	pjm2	1.8
414			' Use the first winsock control to send a UDP packet.
415			UDPSock.RemoteHost = filterHostname
416			UDPSock.RemotePort = filterUDPPort
417			UDPSock.SendData xml
418	pjm2	1.10	Status.Caption = "UDP packet sent"
419	pjm2	1.8	Label3.Caption = UDPUpdateTime
420			End If
421
422			If Label4.Caption < 1 Then
423			' establish a TCP connection to a filter
424			TCPSock.Close
425			TCPSock.Connect filterHostname, filterTCPPort
426			Label4.Caption = TCPUpdateTime
427			End If
428
429			End Sub
430	pjm2	1.13
431			Function Date2Num() As Long
432	pjm2	1.14	Dim x As Long
433			x = DateDiff("s", "1-1-1970", Now)
434			Date2Num = x
435	pjm2	1.13	End Function