host/winhost/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    =   5655
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4710
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5655
   ScaleWidth      =   4710
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Hide 
      Caption         =   "Hide Window"
      Height          =   375
      Left            =   3120
      TabIndex        =   7
      Top             =   840
      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.TextBox Text4 
      Height          =   1575
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Text            =   "nettest.frx":0000
      Top             =   3000
      Width           =   3975
   End
   Begin VB.CommandButton Reconfigure 
      Caption         =   "Reconfigure with FilterManager"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   840
      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 Label5 
      Caption         =   "b e t a"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   24
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   240
      TabIndex        =   8
      Top             =   120
      Width           =   1815
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      Caption         =   "Next heartbeat:"
      Height          =   255
      Left            =   2400
      TabIndex        =   6
      Top             =   480
      Width           =   1455
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Next UDP packet:"
      Height          =   255
      Left            =   2400
      TabIndex        =   5
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label4 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   3960
      TabIndex        =   4
      Top             =   480
      Width           =   615
   End
   Begin VB.Label Label3 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   3960
      TabIndex        =   3
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Status 
      Alignment       =   2  'Center
      Caption         =   "Status:"
      Height          =   255
      Left            =   0
      TabIndex        =   2
      Top             =   1320
      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()
    
    protocolVersion = "1.1"
    
    Status.Caption = "Loading"
    'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
    
    ''''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
skip:

    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
    Reconfigure_Click
    
    Form1.Show
    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
        
        ' 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>" & _
              "</os>" & _
              "<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.18
Committed:	Fri Feb 23 17:51:07 2001 UTC (23 years, 9 months ago) by pjm2
Branch:	MAIN
Changes since 1.17:	+11 -11 lines
Log Message:	Configuration is now read from the INI file. This only needs to specify the hostname and port number of the FilterManager, as the FilterManager itself is responsible for providing the remaining configuration details.
#	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.1	ClientHeight = 5655
8			ClientLeft = 45
9	pjm2	1.17	ClientTop = 330
10	pjm2	1.12	ClientWidth = 4710
11	pjm2	1.1	LinkTopic = "Form1"
12			MaxButton = 0 'False
13	pjm2	1.17	MinButton = 0 'False
14	pjm2	1.1	ScaleHeight = 5655
15	pjm2	1.12	ScaleWidth = 4710
16	pjm2	1.1	ShowInTaskbar = 0 'False
17			StartUpPosition = 3 'Windows Default
18	pjm2	1.11	Begin VB.CommandButton Hide
19	pjm2	1.12	Caption = "Hide Window"
20			Height = 375
21			Left = 3120
22	pjm2	1.11	TabIndex = 7
23	pjm2	1.12	Top = 840
24			Width = 1455
25	pjm2	1.11	End
26			Begin SysTray.SystemTray SystemTray
27	pjm2	1.12	Left = 2160
28			Top = 1800
29	pjm2	1.11	_ExtentX = 847
30			_ExtentY = 847
31			SysTrayText = "i-scream Winhost"
32			IconFile = 0
33			End
34	pjm2	1.8	Begin VB.Timer Timer1
35	pjm2	1.12	Left = 2760
36			Top = 1800
37	pjm2	1.1	End
38			Begin VB.TextBox Text4
39	pjm2	1.6	Height = 1575
40	pjm2	1.1	Left = 240
41			MultiLine = -1 'True
42			ScrollBars = 2 'Vertical
43	pjm2	1.10	TabIndex = 1
44	pjm2	1.1	Text = "nettest.frx":0000
45			Top = 3000
46	pjm2	1.12	Width = 3975
47	pjm2	1.1	End
48	pjm2	1.10	Begin VB.CommandButton Reconfigure
49			Caption = "Reconfigure with FilterManager"
50	pjm2	1.12	Height = 375
51	pjm2	1.10	Left = 120
52			TabIndex = 0
53	pjm2	1.12	Top = 840
54	pjm2	1.10	Width = 2895
55	pjm2	1.1	End
56	pjm2	1.5	Begin MSWinsockLib.Winsock TCPSock
57	pjm2	1.12	Left = 3720
58			Top = 1800
59	pjm2	1.1	_ExtentX = 741
60			_ExtentY = 741
61			_Version = 393216
62			End
63	pjm2	1.5	Begin MSWinsockLib.Winsock UDPSock
64	pjm2	1.12	Left = 3240
65			Top = 1800
66	pjm2	1.1	_ExtentX = 741
67			_ExtentY = 741
68			_Version = 393216
69			Protocol = 1
70			End
71	pjm2	1.17	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	pjm2	1.9	Begin VB.Label Label2
89			Alignment = 1 'Right Justify
90			Caption = "Next heartbeat:"
91	pjm2	1.8	Height = 255
92	pjm2	1.12	Left = 2400
93	pjm2	1.10	TabIndex = 6
94	pjm2	1.9	Top = 480
95			Width = 1455
96	pjm2	1.8	End
97	pjm2	1.9	Begin VB.Label Label1
98			Alignment = 1 'Right Justify
99			Caption = "Next UDP packet:"
100	pjm2	1.8	Height = 255
101	pjm2	1.12	Left = 2400
102	pjm2	1.10	TabIndex = 5
103	pjm2	1.9	Top = 120
104			Width = 1455
105	pjm2	1.8	End
106	pjm2	1.9	Begin VB.Label Label4
107	pjm2	1.10	BorderStyle = 1 'Fixed Single
108	pjm2	1.9	Caption = "0"
109	pjm2	1.7	Height = 255
110	pjm2	1.12	Left = 3960
111	pjm2	1.10	TabIndex = 4
112	pjm2	1.9	Top = 480
113			Width = 615
114	pjm2	1.7	End
115	pjm2	1.9	Begin VB.Label Label3
116	pjm2	1.10	BorderStyle = 1 'Fixed Single
117	pjm2	1.9	Caption = "0"
118	pjm2	1.7	Height = 255
119	pjm2	1.12	Left = 3960
120	pjm2	1.10	TabIndex = 3
121	pjm2	1.9	Top = 120
122			Width = 615
123	pjm2	1.7	End
124	pjm2	1.6	Begin VB.Label Status
125	pjm2	1.12	Alignment = 2 'Center
126	pjm2	1.6	Caption = "Status:"
127	pjm2	1.1	Height = 255
128	pjm2	1.18	Left = 0
129	pjm2	1.10	TabIndex = 2
130	pjm2	1.12	Top = 1320
131	pjm2	1.18	Width = 4695
132	pjm2	1.1	End
133			End
134			Attribute VB_Name = "Form1"
135			Attribute VB_GlobalNameSpace = False
136			Attribute VB_Creatable = False
137			Attribute VB_PredeclaredId = True
138			Attribute VB_Exposed = False
139	pjm2	1.15	' For the system tray bits
140	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
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	pjm2	1.18	Dim filterManagerTCPPort As Long
145	pjm2	1.4
146	pjm2	1.13	Dim seqNo As Long
147			Dim machineName As String
148
149	pjm2	1.2	Dim filterHostname As String
150	pjm2	1.3	Dim filterTCPPort As Integer
151			Dim filterUDPPort As Integer
152			Dim fileList As String
153			Dim lastModified As String
154	pjm2	1.2
155	pjm2	1.7	Dim UDPUpdateTime As Integer
156			Dim TCPUpdateTime As Integer
157
158	pjm2	1.2	Dim protocolVersion As String
159			Dim connected As Boolean
160	pjm2	1.16
161			'Dim CUpTime As New CUpTime
162
163	pjm2	1.1	Dim responseNumber As Integer
164
165	pjm2	1.2	Private Sub Form_Load()
166	pjm2	1.13
167	pjm2	1.2	protocolVersion = "1.1"
168	pjm2	1.13
169	pjm2	1.10	Status.Caption = "Loading"
170	pjm2	1.15	'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
171	pjm2	1.6
172	pjm2	1.4	''''TEMP
173	pjm2	1.18	'filterManagerHostname = "killigrew.ukc.ac.uk"
174			'filterManagerTCPPort = 4567
175	pjm2	1.13	''''' END TEMP
176	pjm2	1.4
177	pjm2	1.18	'GoTo skip
178	pjm2	1.4	On Error GoTo iniError
179			Dim buf As String * 256
180			Dim length As Long
181	pjm2	1.18	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "/winhost.ini")
182	pjm2	1.4	filterManagerHostname = Left$(buf, length)
183	pjm2	1.18	length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
184			filterManagerTCPPort = length
185	pjm2	1.13	skip:
186
187	pjm2	1.18	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
188	pjm2	1.13	Reconfigure_Click
189	pjm2	1.6
190	pjm2	1.15	Form1.Show
191			SystemTray.Action = 0
192
193
194	pjm2	1.4	Exit Sub
195
196			iniError:
197	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")
198	pjm2	1.4	End
199
200			End Sub
201
202	pjm2	1.10	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
203	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")
204	pjm2	1.10	If x = 7 Then
205			Cancel = True
206	pjm2	1.15	Else
207			SystemTray.Action = 2
208	pjm2	1.10	End If
209
210			End Sub
211
212	pjm2	1.11	Private Sub Hide_Click()
213			Form1.Visible = False
214			SystemTray.Icon = Val(Form1.Icon)
215			End Sub
216
217	pjm2	1.10	Private Sub Reconfigure_Click()
218			' establish a TCP connection to a filtermanager
219			connected = False
220			TCPSock.Close
221			TCPSock.Connect filterManagerHostname, filterManagerTCPPort
222	pjm2	1.11	End Sub
223
224
225
226			Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
227
228			Form1.Visible = True
229			Form1.SetFocus
230	pjm2	1.12
231	pjm2	1.11
232	pjm2	1.10	End Sub
233
234	pjm2	1.5	Private Sub TCPSock_Connect()
235	pjm2	1.6
236			responseNumber = 0
237	pjm2	1.1
238	pjm2	1.3	' Send something as soon as we connect to the server.
239			If connected = False Then
240			' contact the FilterManager
241	pjm2	1.5	TCPSock.SendData "STARTCONFIG" & vbCrLf
242	pjm2	1.3	Else
243			' Contact the Filter
244	pjm2	1.5	TCPSock.SendData "HEARTBEAT" & vbCrLf
245	pjm2	1.3	End If
246	pjm2	1.1
247			End Sub
248
249	pjm2	1.5	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
250	pjm2	1.1
251			responseNumber = responseNumber + 1
252
253			' Get the line from the server.
254	pjm2	1.5	TCPSock.GetData response, vbString, bytesTotal
255	pjm2	1.1
256			' Remove linefeeds and returns from the line.
257			response = Replace(response, Chr(13), "")
258			response = Replace(response, Chr(10), "")
259			Text4.Text = Text4.Text & vbCrLf & response
260
261	pjm2	1.2	If connected = False Then
262			' Perform TCP configuration (1.1)
263			On Error GoTo configError
264			Select Case responseNumber
265			Case 1:
266			If Not response = "OK" Then GoTo configError
267	pjm2	1.5	TCPSock.SendData "LASTMODIFIED" & vbCrLf
268	pjm2	1.2	Case 2:
269			If response = "ERROR" Then GoTo configError
270	pjm2	1.3	lastModified = response
271	pjm2	1.5	TCPSock.SendData "FILELIST" & vbCrLf
272	pjm2	1.2	Case 3:
273			If response = "ERROR" Then GoTo configError
274	pjm2	1.3	fileList = response
275	pjm2	1.5	TCPSock.SendData "UDPUpdateTime" & vbCrLf
276	pjm2	1.2	Case 4:
277			If response = "ERROR" Then GoTo configError
278	pjm2	1.7	UDPUpdateTime = response
279	pjm2	1.5	TCPSock.SendData "TCPUpdateTime" & vbCrLf
280	pjm2	1.2	Case 5:
281			If response = "ERROR" Then GoTo configError
282	pjm2	1.7	TCPUpdateTime = response
283	pjm2	1.5	TCPSock.SendData "ENDCONFIG" & vbCrLf
284	pjm2	1.2	Case 6:
285			If Not response = "OK" Then GoTo configError
286	pjm2	1.5	TCPSock.SendData "FILTER" & vbCrLf
287	pjm2	1.2	Case 7:
288			'we got a filter list here.
289			readTo = 0
290			' get hostname
291			readTo = InStr(1, response, ";", vbBinaryCompare)
292			filterHostname = Mid(response, 1, readTo - 1)
293			response = Mid(response, readTo + 1, Len(response))
294			' get UDP Port number
295			readTo = InStr(1, response, ";")
296			filterUDPPort = Mid(response, 1, readTo - 1)
297			response = Mid(response, readTo + 1, Len(response))
298			' get TCP Port number
299			filterTCPPort = response
300	pjm2	1.5	TCPSock.SendData "END" & vbCrLf
301	pjm2	1.2	Case 8:
302			If Not response = "OK" Then GoTo configError
303			connected = True
304			responseNumber = 0
305	pjm2	1.5	TCPSock.Close
306	pjm2	1.2	Text4.Text = Text4.Text & vbCrLf & " <closed>"
307	pjm2	1.10	Status.Caption = "Configuration successful"
308	pjm2	1.8	Label3.Caption = UDPUpdateTime
309			Label4.Caption = TCPUpdateTime
310			Timer1.Interval = 1000
311	pjm2	1.2	End Select
312			Else
313			' Perform a heartbeat (1.1)
314			On Error GoTo heartbeatError
315			Select Case responseNumber
316			Case 1:
317	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
318	pjm2	1.5	TCPSock.SendData "CONFIG" & vbCrLf
319	pjm2	1.2	Case 2:
320	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
321	pjm2	1.5	TCPSock.SendData fileList & vbCrLf
322	pjm2	1.2	Case 3:
323	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
324	pjm2	1.5	TCPSock.SendData lastModified & vbCrLf
325	pjm2	1.2	Case 4:
326	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
327	pjm2	1.5	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
328	pjm2	1.2	Case 5:
329	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
330	pjm2	1.5	TCPSock.Close
331	pjm2	1.10	Status.Caption = "Heartbeat sent successfully."
332	pjm2	1.2	End Select
333
334			End If
335
336
337			Exit Sub
338
339			configError:
340	pjm2	1.10	Status.Caption = "FAILED to get configuration"
341	pjm2	1.8	Exit Sub
342	pjm2	1.2	heartbeatError:
343	pjm2	1.10	Status.Caption = "Heatbeat FAILED"
344	pjm2	1.8	Exit Sub
345	pjm2	1.1	End Sub
346	pjm2	1.5
347	pjm2	1.8	Private Sub Timer1_Timer()
348
349			Label3.Caption = Label3.Caption - 1
350			Label4.Caption = Label4.Caption - 1
351
352	pjm2	1.10	Status.Caption = ""
353	pjm2	1.8
354			If Label3.Caption < 1 Then
355	pjm2	1.15
356			' prepare the contents of the XML packet.
357			seqNo = seqNo + 1
358			machineName = TCPSock.LocalHostName
359	pjm2	1.16	LocalIP = TCPSock.LocalIP
360	pjm2	1.14	packetDate = Date2Num()
361	pjm2	1.15
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	pjm2	1.16	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
407	pjm2	1.15	"<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	pjm2	1.17	"</packet>"
418	pjm2	1.13	Text4.Text = Text4.Text + xml
419	pjm2	1.8
420			' Use the first winsock control to send a UDP packet.
421			UDPSock.RemoteHost = filterHostname
422			UDPSock.RemotePort = filterUDPPort
423			UDPSock.SendData xml
424	pjm2	1.10	Status.Caption = "UDP packet sent"
425	pjm2	1.8	Label3.Caption = UDPUpdateTime
426			End If
427
428			If Label4.Caption < 1 Then
429			' establish a TCP connection to a filter
430			TCPSock.Close
431			TCPSock.Connect filterHostname, filterTCPPort
432			Label4.Caption = TCPUpdateTime
433			End If
434
435			End Sub
436	pjm2	1.13
437			Function Date2Num() As Long
438	pjm2	1.14	Dim x As Long
439			x = DateDiff("s", "1-1-1970", Now)
440			Date2Num = x
441	pjm2	1.13	End Function