--- experimental/host/vb_net_test/nettest.frm	2001/02/22 17:04:22	1.1
+++ experimental/host/vb_net_test/nettest.frm	2001/02/28 09:18:26	1.27
@@ -1,117 +1,127 @@
 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         =   "TCP/UDP Test program"
-   ClientHeight    =   5655
+   Caption         =   "i-scream Winhost"
+   ClientHeight    =   1185
    ClientLeft      =   45
    ClientTop       =   330
-   ClientWidth     =   5670
+   ClientWidth     =   4710
+   Icon            =   "nettest.frx":0000
    LinkTopic       =   "Form1"
    MaxButton       =   0   'False
    MinButton       =   0   'False
-   ScaleHeight     =   5655
-   ScaleWidth      =   5670
+   ScaleHeight     =   1185
+   ScaleWidth      =   4710
    ShowInTaskbar   =   0   'False
-   StartUpPosition =   3  'Windows Default
-   Begin VB.CommandButton Command3 
-      Caption         =   "TCP to Filter"
-      Height          =   375
-      Left            =   3720
-      TabIndex        =   9
-      Top             =   2520
-      Width           =   1575
+   StartUpPosition =   2  'CenterScreen
+   Visible         =   0   'False
+   Begin VB.CommandButton Command1 
+      Caption         =   "more"
+      Height          =   255
+      Left            =   3960
+      TabIndex        =   8
+      Top             =   840
+      Width           =   615
    End
-   Begin VB.TextBox Text4 
-      Height          =   2535
-      Left            =   240
+   Begin VB.TextBox Text1 
+      Height          =   2055
+      Left            =   120
+      Locked          =   -1  'True
       MultiLine       =   -1  'True
       ScrollBars      =   2  'Vertical
-      TabIndex        =   8
-      Text            =   "nettest.frx":0000
-      Top             =   3000
-      Width           =   5055
-   End
-   Begin VB.CommandButton Command2 
-      Caption         =   "TCP to FilterManager"
-      Height          =   375
-      Left            =   3360
       TabIndex        =   7
-      Top             =   2040
-      Width           =   1935
+      Top             =   1200
+      Width           =   4455
    End
-   Begin MSWinsockLib.Winsock Winsock2 
-      Left            =   4920
-      Top             =   120
-      _ExtentX        =   741
-      _ExtentY        =   741
-      _Version        =   393216
+   Begin VB.CommandButton Hide 
+      Caption         =   "hide"
+      Height          =   255
+      Left            =   3960
+      TabIndex        =   6
+      Top             =   480
+      Width           =   615
    End
-   Begin VB.TextBox Text3 
-      Height          =   285
-      Left            =   1680
-      TabIndex        =   5
-      Text            =   "killigrew.ukc.ac.uk"
-      Top             =   1560
-      Width           =   2535
+   Begin SysTray.SystemTray SystemTray 
+      Left            =   2520
+      Top             =   4200
+      _ExtentX        =   847
+      _ExtentY        =   847
+      SysTrayText     =   "i-scream Winhost"
+      IconFile        =   0
    End
-   Begin VB.TextBox Text2 
-      Height          =   285
-      Left            =   1680
-      TabIndex        =   3
-      Text            =   "4567"
-      Top             =   1920
-      Width           =   855
+   Begin VB.Timer Timer1 
+      Left            =   3120
+      Top             =   4200
    End
-   Begin VB.CommandButton Command1 
-      Caption         =   "Send UDP"
+   Begin VB.CommandButton Reconfigure 
+      Caption         =   "Reconfigure with FilterManager"
       Height          =   375
-      Left            =   4320
-      TabIndex        =   2
-      Top             =   1560
-      Width           =   975
-   End
-   Begin VB.TextBox Text1 
-      Height          =   855
-      Left            =   360
+      Left            =   840
       TabIndex        =   0
-      Text            =   "<packet></packet>"
-      Top             =   600
-      Width           =   4935
+      Top             =   3480
+      Width           =   2895
    End
-   Begin MSWinsockLib.Winsock Winsock1 
-      Left            =   4320
-      Top             =   120
+   Begin MSWinsockLib.Winsock TCPSock 
+      Left            =   4080
+      Top             =   4200
       _ExtentX        =   741
       _ExtentY        =   741
       _Version        =   393216
+   End
+   Begin MSWinsockLib.Winsock UDPSock 
+      Left            =   3600
+      Top             =   4200
+      _ExtentX        =   741
+      _ExtentY        =   741
+      _Version        =   393216
       Protocol        =   1
    End
-   Begin VB.Label Label3 
+   Begin VB.Label Label2 
       Alignment       =   1  'Right Justify
-      Caption         =   "Destination:"
+      Caption         =   "Next heartbeat:"
       Height          =   255
-      Left            =   360
-      TabIndex        =   6
-      Top             =   1560
-      Width           =   1215
+      Left            =   120
+      TabIndex        =   5
+      Top             =   480
+      Width           =   1455
    End
-   Begin VB.Label Label2 
+   Begin VB.Label Label1 
       Alignment       =   1  'Right Justify
-      Caption         =   "Port:"
+      Caption         =   "Next UDP packet:"
       Height          =   255
-      Left            =   360
+      Left            =   120
       TabIndex        =   4
-      Top             =   1920
-      Width           =   1215
+      Top             =   120
+      Width           =   1455
    End
-   Begin VB.Label Label1 
-      Caption         =   "Packet contents"
+   Begin VB.Label Label4 
+      BorderStyle     =   1  'Fixed Single
+      Caption         =   "0"
       Height          =   255
-      Left            =   360
+      Left            =   1680
+      TabIndex        =   3
+      Top             =   480
+      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             =   360
-      Width           =   2895
+      Top             =   840
+      Width           =   3855
    End
 End
 Attribute VB_Name = "Form1"
@@ -119,71 +129,374 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
-Dim responseNumber As Integer
+' 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 windowBig As Boolean
+
+Dim responseNumber As Integer
+
 Private Sub Command1_Click()
 
-    ' Use the first winsock control to send
-    ' a UDP packet.
-    Winsock1.RemoteHost = Text3.Text
-    Winsock1.RemotePort = Text2.Text
-    Winsock1.SendData Text1.Text
+    ' Toggle visibility of the debug output.
 
+    If windowBig Then
+        Form1.Height = 1500
+        windowBig = False
+    Else
+        Form1.Height = 4350
+        windowBig = True
+    End If
+
 End Sub
 
-Private Sub Command2_Click()
+Private Sub Form_Load()
     
-    ' establish a TCP connection to a machine
-    Winsock2.Close
-    Winsock2.Connect Text3.Text, Text2.Text
+    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
+    
+    windowBig = False
+    
+    ''''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 Command3_Click()
-    x = MsgBox("not implemented..")
+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 Winsock2_Connect()
-      
-   responseNumber = 0
+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
    
-   ' As soon as we are connected to the server, send this.
-   Winsock2.SendData "STARTCONFIG" & vbCrLf
+    ' 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 Winsock2_DataArrival(ByVal bytesTotal As Long)
+Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
     
     responseNumber = responseNumber + 1
     
     ' Get the line from the server.
-    Winsock2.GetData response, vbString, bytesTotal
+    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
+    'Text4.Text = Text4.Text & vbCrLf & response
     
-    ' Decide what to send back to the server.
-    Select Case responseNumber
-        Case 1:
-            Winsock2.SendData "LASTMODIFIED" & vbCrLf
-        Case 2:
-            Winsock2.SendData "FILELIST" & vbCrLf
-        Case 3:
-            Winsock2.SendData "UDPUpdateTime" & vbCrLf
-        Case 4:
-            Winsock2.SendData "TCPUpdateTime" & vbCrLf
-        Case 5:
-            Winsock2.SendData "ENDCONFIG" & vbCrLf
-        Case 6:
-            Winsock2.SendData "FILTER" & vbCrLf
-        Case 7:
-            Winsock2.SendData "END" & vbCrLf
-        Case 8:
-            Winsock2.Close
-            Text4.Text = Text4.Text & vbCrLf & "  <closed>"
-    End Select
+    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
+                Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
+                Text1.Text = Text1.Text & response & vbCrLf
+            Case 2:
+                If response = "ERROR" Then GoTo configError
+                lastModified = response
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData "FILELIST" & vbCrLf
+            ''' Uncomment this for new protocol release.
+            'Case 2a:
+                'If response = "ERROR" Then GoTo configError
+                'fileList = response
+                'Text1.Text = Text1.Text & response & vbCrLf
+                'TCPSock.SendData "FQDN" & vbCrLf
+            Case 3:
+                If response = "ERROR" Then GoTo configError
+                fileList = response
+                Text1.Text = Text1.Text & response & vbCrLf
+                ' REMOVE above line, uncomment next
+                'machineName = response
+                TCPSock.SendData "UDPUpdateTime" & vbCrLf
+            Case 4:
+                If response = "ERROR" Then GoTo configError
+                UDPUpdateTime = response
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData "TCPUpdateTime" & vbCrLf
+            Case 5:
+                If response = "ERROR" Then GoTo configError
+                TCPUpdateTime = response
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData "ENDCONFIG" & vbCrLf
+            Case 6:
+                If Not response = "OK" Then GoTo configError
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData "FILTER" & vbCrLf
+            Case 7:
+                Text1.Text = Text1.Text & response & vbCrLf
+                '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
+                Text1.Text = Text1.Text & response & vbCrLf
+                '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
+                Text1.Text = "Performing heartbeat: -" & vbCrLf
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData "CONFIG" & vbCrLf
+            Case 2:
+                If Not response = "OK" Then GoTo heartbeatError
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData fileList & vbCrLf
+            Case 3:
+                If Not response = "OK" Then GoTo heartbeatError
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData lastModified & vbCrLf
+            Case 4:
+                If Not response = "OK" Then GoTo heartbeatError
+                Text1.Text = Text1.Text & response & vbCrLf
+                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
+            Case 5:
+                If Not response = "OK" Then GoTo heartbeatError
+                Text1.Text = Text1.Text & response & vbCrLf
+                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
+        
+        ' Comment this line in the next protocol
+        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>"
+        Text1.Text = "Last packet contained: -" & vbCrLf & 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