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     =   4  'Fixed ToolWindow
   Caption         =   "i-scream Winhost"
   ClientHeight    =   5655
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   4710
   LinkTopic       =   "Form1"
   MaxButton       =   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 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            =   120
      TabIndex        =   2
      Top             =   1320
      Width           =   4455
   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 Integer

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 = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
    filterManagerTCPPort = Left$(buf, length)
skip:

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