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    =   1380
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4635
   Icon            =   "nettest.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1380
   ScaleWidth      =   4635
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Visible         =   0   'False
   Begin VB.CommandButton Command1 
      Caption         =   "more"
      Height          =   255
      Left            =   3885
      TabIndex        =   8
      Top             =   1035
      Width           =   615
   End
   Begin VB.TextBox Text1 
      Height          =   2055
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   7
      Top             =   1440
      Width           =   4395
   End
   Begin VB.CommandButton Hide 
      Caption         =   "hide"
      Height          =   255
      Left            =   3225
      TabIndex        =   6
      Top             =   1035
      Width           =   615
   End
   Begin SysTray.SystemTray SystemTray 
      Left            =   2520
      Top             =   4200
      _ExtentX        =   847
      _ExtentY        =   847
      SysTrayText     =   "i-scream Winhost"
      IconFile        =   0
   End
   Begin VB.Timer Timer1 
      Left            =   3120
      Top             =   4200
   End
   Begin VB.CommandButton Reconfigure 
      Caption         =   "Reconfigure with FilterManager"
      Height          =   375
      Left            =   840
      TabIndex        =   0
      Top             =   3555
      Width           =   2895
   End
   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.Image Image1 
      Height          =   900
      Left            =   2400
      Picture         =   "nettest.frx":08CA
      Top             =   90
      Width           =   2100
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      Caption         =   "Next heartbeat:"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   645
      Width           =   1455
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Next UDP packet:"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   165
      Width           =   1455
   End
   Begin VB.Label Label4 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   1680
      TabIndex        =   3
      Top             =   645
      Width           =   615
   End
   Begin VB.Label Label3 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   1680
      TabIndex        =   2
      Top             =   165
      Width           =   615
   End
   Begin VB.Label Status 
      Alignment       =   2  'Center
      Caption         =   "Status:"
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   1035
      Width           =   3180
   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 methods
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

' Address of the filter manager
Dim filterManagerHostname As String
Dim filterManagerTCPPort As Long

' Sequence number and machine name are sent in each UDP packet.
Dim seqNo As Long
Dim machineName As String

' DEPRICATED.  The number of seconds that the program has been running.
Dim secondsRunning As Long

' Address of the filter to use.
Dim filterHostname As String
Dim filterTCPPort As Integer
Dim filterUDPPort As Integer

' Server configuration details.
Dim fileList As String
Dim lastModified As String

' Time intervals between UDP packets and heartbeats.
Dim UDPUpdateTime As Integer
Dim TCPUpdateTime As Integer

' The protocol version used by the winhost.
Dim protocolVersion As String

' Action flags.
Dim connected As Boolean
Dim heartBeating As Boolean
Dim windowBig As Boolean

' Define classes to be used to obtain uptime and number of users.
Dim CUpTime As New CUpTime
Dim wksta As New CNetWksta

' Keep track of the line number in TCP communications.
Dim responseNumber As Integer


' Toggle visibility of the debug output.
Private Sub Command1_Click()
    If windowBig Then
        Form1.Height = 1755
        windowBig = False
    Else
        Form1.Height = 4380
        windowBig = True
    End If
End Sub


' Main method (or its Visual Basic equivalent!).
Private Sub Form_Load()
    
    ' Do not let any user run the program twice on one machine.
    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
    
    ' Some class functions only work on NT-based systems, and Win9x boxes
    ' are rarely used as servers, anyway.
    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
    
    ' Start the program with the small window size.
    windowBig = False
    
    ' Catch errors while reading the configuration from the ini file.
    On Error GoTo iniError
    
    Dim buf As String * 256
    Dim length As Long
    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "", 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
    
    ' Resume normal error handling.
    On Error GoTo 0

    ' We have the configuration.  Now connect.
    Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
    Reconfigure_Click
    
    ' Install the icon in the system tray.
    SystemTray.Icon = Val(Form1.Icon)
    SystemTray.Action = 0
    
    
    Exit Sub
    
' Error handler
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


' Unload event.  Also fires when the machine is shutting down.
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
    ' Prevent users from unwittingly shutting down thet winhost.
    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
        ' Remove the icon from the system tray.
        SystemTray.Action = 2
    End If

End Sub


' Make the form disappear and update the icon in the system tray.
Private Sub Hide_Click()
    Form1.Visible = False
    SystemTray.Icon = Val(Form1.Icon)
End Sub


' Reconfigure the host with the filter manager.
Private Sub Reconfigure_Click()
    ' establish a TCP connection to a filtermanager, provided another TCP
    ' communication is not already taking place.
    If Not heartBeating Then
        connected = False
        TCPSock.Close
        TCPSock.Connect filterManagerHostname, filterManagerTCPPort
    Else
        Status.Caption = "Cannot reconfigure while heartbeating"
    End If
End Sub


' Do this when the user double-clicks on the system tray icon.
Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
    ' After double-clicking on the system tray icon, we make the
    ' form visible and give it active focus.
    Form1.Visible = True
    Form1.SetFocus

End Sub


' Establish a connection with the filter manager.
' Thereafter, use the filter instead.
Private Sub TCPSock_Connect()
    
    ' Start from the first line of the response.
    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


' Deal with TCP traffic coming from the filter or filter manager.
Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
    
    ' Move to the next line of the response.
    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), "")
    
    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
            Case 3:
                If response = "ERROR" Then GoTo configError
                fileList = response
                Text1.Text = Text1.Text & response & vbCrLf
                TCPSock.SendData "FQDN" & vbCrLf
            Case 4:
                If response = "ERROR" Then GoTo configError
                Text1.Text = Text1.Text & response & vbCrLf
                machineName = response
                TCPSock.SendData "UDPUpdateTime" & vbCrLf
            Case 5:
                If response = "ERROR" Then GoTo configError
                UDPUpdateTime = response
                Text1.Text = Text1.Text & response & vbCrLf
                TCPSock.SendData "TCPUpdateTime" & vbCrLf
            Case 6:
                If response = "ERROR" Then GoTo configError
                TCPUpdateTime = response
                Text1.Text = Text1.Text & response & vbCrLf
                TCPSock.SendData "ENDCONFIG" & vbCrLf
            Case 7:
                If Not response = "OK" Then GoTo configError
                Text1.Text = Text1.Text & response & vbCrLf
                TCPSock.SendData "FILTER" & vbCrLf
            Case 8:
                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 9:
                If Not response = "OK" Then GoTo configError
                connected = True
                responseNumber = 0
                ' We've finished with the socket now.
                TCPSock.Close
                Text1.Text = Text1.Text & response & vbCrLf
                Status.Caption = "Configuration successful"
                Label3.Caption = UDPUpdateTime
                Label4.Caption = TCPUpdateTime
                Timer1.Interval = 1000
        End Select
    Else
        ' Perform a heartbeat (1.1)
        heartBeating = True
        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:
                ' Reconfigure if the server configuration for the
                ' host has been altered.
                If Not response = "OK" Then
                    heartBeating = False
                    Reconfigure_Click
                End If
                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."
                heartBeating = False
        End Select
    
    End If
    
    
    Exit Sub
    
configError:
    heartBeating = False
    Status.Caption = "FAILED to get configuration from the server"
    Exit Sub
heartbeatError:
    heartBeating = False
    Status.Caption = "Heatbeat FAILED"
    Exit Sub
End Sub


' Deal with the construction and sending of UDP packets.
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
        
        ' Windows machines can provide their NetBIOS name to assist
        ' in identifying the machine.
        netbiosName = TCPSock.LocalHostName
        
        ' The I.P. address of the host machine.
        LocalIP = TCPSock.LocalIP
        
        ' The date according to the host machine (formatted as the
        ' number of seconds since the epoch).
        packetDate = Date2Num()
        
        ' Attempt to return Windows version information with the API.
        Dim verinfo As OSVERSIONINFO
        verinfo.dwOSVersionInfoSize = Len(verinfo)
        ret% = GetVersionEx(verinfo)
        If ret% = 0 Then
            Text1.Text = Text1.Text & vbCrLf & "Error getting Windows version Information"
            End
        End If
          
        ' Now get all of the version information.
        osName = GetVersion()
        osVersionMajor = verinfo.dwMajorVersion
        osVersionMinor = verinfo.dwMinorVersion
        osBuild = verinfo.dwBuildNumber
        
        ' Find out what type of processor the host is using.
        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
        
        ' Find the amount of swap memory and physical memory
        ' (both free and total)
        Dim memsts As MEMORYSTATUS
        Dim memory&
        GlobalMemoryStatus memsts
        memory& = memsts.dwTotalPhys
        memTotal = memory& \ 1048576
        memory& = memsts.dwAvailPhys
        memFree = memory& \ 1048576
        memory& = memsts.dwTotalVirtual
        swapTotal = memory& \ 1048576
        memory& = memsts.dwAvailVirtual
        swapFree = memory& \ 1048576
        
        ' Cause the CUpTime class to capture its data.
        CUpTime.Capture
        
        ' Get the processor occupancy percentages.
        cpu_time = CUpTime.CPUTime
        percent_idle = CUpTime.PercentIdle
        
        ' Get the uptime for the host.  DO NOT use integer division here,
        ' as this will cause the result to overflow if the machine has
        ' been up for more than ~47 days.
        uptime = CUpTime.MilliSecs / 1000#
        
        ' Use the CNetWksta class to find out how many users are logged
        ' on to the system.
        userCount = wksta.LoggedOnUsers
        
        ' build the contents of the XML packet
        xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
              "<os>" & _
                "<netbios_name>" & netbiosName & "</netbios_name>" & _
                "<name>" & osName & "</name>" & _
                "<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
                "<release>" & osBuild & "</release>" & _
                "<platform>" & processorType & "</platform>" & _
                "<uptime>" & uptime & "</uptime>" & _
              "</os>" & _
              "<users><count>" & userCount & "</count></users>" & _
              "<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>"
        
        ' Show the interested user what we are sending.
        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


' Format the current date and time as a long integer representing
' the number of seconds since the epoch.
Function Date2Num() As Long
    Dim x As Long
    x = DateDiff("s", "1-1-1970", Now)
    Date2Num = x
End Function
Revision:	1.40
Committed:	Fri Mar 28 16:30:35 2003 UTC (21 years, 8 months ago) by tdb
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.39:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	Removed some un-used code from CVS. We can always resurrect this later if someone feels they want to work on it. Gone are the old perl ihost which isn't needed now, winhost which is broken and shows no sign of being fixed, and DBReporter. If someone wants to revive them, I'll undelete them :-)
#	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.37	ClientHeight = 1380
8	pjm2	1.1	ClientLeft = 45
9	pjm2	1.17	ClientTop = 330
10	pjm2	1.37	ClientWidth = 4635
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.37	ScaleHeight = 1380
16			ScaleWidth = 4635
17	pjm2	1.1	ShowInTaskbar = 0 'False
18	pjm2	1.24	StartUpPosition = 2 'CenterScreen
19			Visible = 0 'False
20	pjm2	1.26	Begin VB.CommandButton Command1
21			Caption = "more"
22			Height = 255
23	pjm2	1.37	Left = 3885
24	pjm2	1.26	TabIndex = 8
25	pjm2	1.37	Top = 1035
26	pjm2	1.26	Width = 615
27			End
28			Begin VB.TextBox Text1
29			Height = 2055
30			Left = 120
31			Locked = -1 'True
32			MultiLine = -1 'True
33			ScrollBars = 2 'Vertical
34			TabIndex = 7
35	pjm2	1.37	Top = 1440
36			Width = 4395
37	pjm2	1.26	End
38	pjm2	1.11	Begin VB.CommandButton Hide
39	pjm2	1.27	Caption = "hide"
40			Height = 255
41	pjm2	1.37	Left = 3225
42	pjm2	1.24	TabIndex = 6
43	pjm2	1.37	Top = 1035
44	pjm2	1.27	Width = 615
45	pjm2	1.11	End
46			Begin SysTray.SystemTray SystemTray
47	pjm2	1.26	Left = 2520
48			Top = 4200
49	pjm2	1.11	_ExtentX = 847
50			_ExtentY = 847
51			SysTrayText = "i-scream Winhost"
52			IconFile = 0
53			End
54	pjm2	1.8	Begin VB.Timer Timer1
55	pjm2	1.26	Left = 3120
56			Top = 4200
57	pjm2	1.1	End
58	pjm2	1.10	Begin VB.CommandButton Reconfigure
59			Caption = "Reconfigure with FilterManager"
60	pjm2	1.12	Height = 375
61	pjm2	1.26	Left = 840
62	pjm2	1.10	TabIndex = 0
63	pjm2	1.37	Top = 3555
64	pjm2	1.10	Width = 2895
65	pjm2	1.1	End
66	pjm2	1.5	Begin MSWinsockLib.Winsock TCPSock
67	pjm2	1.26	Left = 4080
68			Top = 4200
69	pjm2	1.1	_ExtentX = 741
70			_ExtentY = 741
71			_Version = 393216
72			End
73	pjm2	1.5	Begin MSWinsockLib.Winsock UDPSock
74	pjm2	1.26	Left = 3600
75			Top = 4200
76	pjm2	1.1	_ExtentX = 741
77			_ExtentY = 741
78			_Version = 393216
79			Protocol = 1
80			End
81	pjm2	1.37	Begin VB.Image Image1
82			Height = 900
83			Left = 2400
84	tdb	1.38	Picture = "nettest.frx":08CA
85	pjm2	1.37	Top = 90
86			Width = 2100
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.26	Left = 120
93	pjm2	1.24	TabIndex = 5
94	pjm2	1.37	Top = 645
95	pjm2	1.9	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.24	Left = 120
102			TabIndex = 4
103	pjm2	1.37	Top = 165
104	pjm2	1.9	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.26	Left = 1680
111	pjm2	1.24	TabIndex = 3
112	pjm2	1.37	Top = 645
113	pjm2	1.9	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.24	Left = 1680
120			TabIndex = 2
121	pjm2	1.37	Top = 165
122	pjm2	1.9	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.24	TabIndex = 1
130	pjm2	1.37	Top = 1035
131			Width = 3180
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.39	' For the system tray methods
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	pjm2	1.39	' Address of the filter manager
144	pjm2	1.4	Dim filterManagerHostname As String
145	pjm2	1.18	Dim filterManagerTCPPort As Long
146	pjm2	1.4
147	pjm2	1.39	' Sequence number and machine name are sent in each UDP packet.
148	pjm2	1.13	Dim seqNo As Long
149			Dim machineName As String
150
151	pjm2	1.39	' DEPRICATED. The number of seconds that the program has been running.
152	pjm2	1.32	Dim secondsRunning As Long
153
154	pjm2	1.39	' Address of the filter to use.
155	pjm2	1.2	Dim filterHostname As String
156	pjm2	1.3	Dim filterTCPPort As Integer
157			Dim filterUDPPort As Integer
158	pjm2	1.39
159			' Server configuration details.
160	pjm2	1.3	Dim fileList As String
161			Dim lastModified As String
162	pjm2	1.2
163	pjm2	1.39	' Time intervals between UDP packets and heartbeats.
164	pjm2	1.7	Dim UDPUpdateTime As Integer
165			Dim TCPUpdateTime As Integer
166
167	pjm2	1.39	' The protocol version used by the winhost.
168	pjm2	1.2	Dim protocolVersion As String
169	pjm2	1.39
170			' Action flags.
171	pjm2	1.2	Dim connected As Boolean
172	pjm2	1.34	Dim heartBeating As Boolean
173	pjm2	1.39	Dim windowBig As Boolean
174	pjm2	1.16
175	pjm2	1.39	' Define classes to be used to obtain uptime and number of users.
176	pjm2	1.21	Dim CUpTime As New CUpTime
177	pjm2	1.25	Dim wksta As New CNetWksta
178	pjm2	1.16
179	pjm2	1.39	' Keep track of the line number in TCP communications.
180			Dim responseNumber As Integer
181	pjm2	1.26
182	pjm2	1.1
183	pjm2	1.39	' Toggle visibility of the debug output.
184	pjm2	1.26	Private Sub Command1_Click()
185			If windowBig Then
186	pjm2	1.37	Form1.Height = 1755
187	pjm2	1.26	windowBig = False
188			Else
189	pjm2	1.37	Form1.Height = 4380
190	pjm2	1.26	windowBig = True
191			End If
192	pjm2	1.39	End Sub
193	pjm2	1.26
194
195	pjm2	1.39	' Main method (or its Visual Basic equivalent!).
196	pjm2	1.2	Private Sub Form_Load()
197	pjm2	1.13
198	pjm2	1.39	' Do not let any user run the program twice on one machine.
199	pjm2	1.22	If App.PrevInstance Then
200			x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running")
201	pjm2	1.25	End
202	pjm2	1.22	End If
203
204	pjm2	1.2	protocolVersion = "1.1"
205	pjm2	1.13
206	pjm2	1.10	Status.Caption = "Loading"
207	pjm2	1.21	Form1.Caption = "i-scream Winhost " & protocolVersion
208
209			CUpTime.Init
210
211	pjm2	1.39	' Some class functions only work on NT-based systems, and Win9x boxes
212			' are rarely used as servers, anyway.
213	pjm2	1.21	If CUpTime.isWin9x Then
214	pjm2	1.25	x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server")
215	pjm2	1.21	End
216			End If
217	pjm2	1.6
218	pjm2	1.39	' Start the program with the small window size.
219	pjm2	1.26	windowBig = False
220
221	pjm2	1.39	' Catch errors while reading the configuration from the ini file.
222			On Error GoTo iniError
223	pjm2	1.4
224			Dim buf As String * 256
225			Dim length As Long
226	pjm2	1.39	length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "", buf, Len(buf), App.Path & "/winhost.ini")
227	pjm2	1.4	filterManagerHostname = Left$(buf, length)
228	pjm2	1.18	length = GetPrivateProfileInt("i-scream Winhost", "FilterManagerPort", 0, App.Path & "/winhost.ini")
229			filterManagerTCPPort = length
230	pjm2	1.39
231	pjm2	1.25	If filterManagerHostname = "" Then
232			GoTo iniError
233			End If
234	pjm2	1.39
235			' Resume normal error handling.
236	pjm2	1.20	On Error GoTo 0
237	pjm2	1.13
238	pjm2	1.39	' We have the configuration. Now connect.
239	pjm2	1.18	Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort
240	pjm2	1.13	Reconfigure_Click
241	pjm2	1.6
242	pjm2	1.39	' Install the icon in the system tray.
243	pjm2	1.20	SystemTray.Icon = Val(Form1.Icon)
244	pjm2	1.15	SystemTray.Action = 0
245
246
247	pjm2	1.4	Exit Sub
248
249	pjm2	1.39	' Error handler
250	pjm2	1.4	iniError:
251	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")
252	pjm2	1.4	End
253
254			End Sub
255
256	pjm2	1.39
257			' Unload event. Also fires when the machine is shutting down.
258	pjm2	1.10	Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
259	pjm2	1.39
260			' Prevent users from unwittingly shutting down thet winhost.
261	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")
262	pjm2	1.10	If x = 7 Then
263			Cancel = True
264	pjm2	1.15	Else
265	pjm2	1.39	' Remove the icon from the system tray.
266	pjm2	1.15	SystemTray.Action = 2
267	pjm2	1.10	End If
268
269			End Sub
270
271	pjm2	1.39
272			' Make the form disappear and update the icon in the system tray.
273	pjm2	1.11	Private Sub Hide_Click()
274			Form1.Visible = False
275			SystemTray.Icon = Val(Form1.Icon)
276			End Sub
277
278	pjm2	1.30
279	pjm2	1.39	' Reconfigure the host with the filter manager.
280	pjm2	1.10	Private Sub Reconfigure_Click()
281	pjm2	1.39	' establish a TCP connection to a filtermanager, provided another TCP
282			' communication is not already taking place.
283	pjm2	1.34	If Not heartBeating Then
284			connected = False
285			TCPSock.Close
286			TCPSock.Connect filterManagerHostname, filterManagerTCPPort
287			Else
288			Status.Caption = "Cannot reconfigure while heartbeating"
289			End If
290	pjm2	1.11	End Sub
291
292
293	pjm2	1.39	' Do this when the user double-clicks on the system tray icon.
294	pjm2	1.11	Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
295	pjm2	1.39	' After double-clicking on the system tray icon, we make the
296			' form visible and give it active focus.
297	pjm2	1.11	Form1.Visible = True
298			Form1.SetFocus
299
300	pjm2	1.10	End Sub
301
302	pjm2	1.39
303			' Establish a connection with the filter manager.
304			' Thereafter, use the filter instead.
305	pjm2	1.5	Private Sub TCPSock_Connect()
306	pjm2	1.6
307	pjm2	1.39	' Start from the first line of the response.
308	pjm2	1.6	responseNumber = 0
309	pjm2	1.39
310	pjm2	1.3	' Send something as soon as we connect to the server.
311			If connected = False Then
312			' contact the FilterManager
313	pjm2	1.5	TCPSock.SendData "STARTCONFIG" & vbCrLf
314	pjm2	1.3	Else
315			' Contact the Filter
316	pjm2	1.5	TCPSock.SendData "HEARTBEAT" & vbCrLf
317	pjm2	1.3	End If
318	pjm2	1.1
319			End Sub
320
321	pjm2	1.39
322			' Deal with TCP traffic coming from the filter or filter manager.
323	pjm2	1.5	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
324	pjm2	1.1
325	pjm2	1.39	' Move to the next line of the response.
326	pjm2	1.1	responseNumber = responseNumber + 1
327
328			' Get the line from the server.
329	pjm2	1.5	TCPSock.GetData response, vbString, bytesTotal
330	pjm2	1.1
331			' Remove linefeeds and returns from the line.
332			response = Replace(response, Chr(13), "")
333			response = Replace(response, Chr(10), "")
334
335	pjm2	1.2	If connected = False Then
336			' Perform TCP configuration (1.1)
337			On Error GoTo configError
338			Select Case responseNumber
339			Case 1:
340			If Not response = "OK" Then GoTo configError
341	pjm2	1.5	TCPSock.SendData "LASTMODIFIED" & vbCrLf
342	pjm2	1.26	Text1.Text = "Requesting configuration from FilterManager:- " & vbCrLf
343			Text1.Text = Text1.Text & response & vbCrLf
344	pjm2	1.2	Case 2:
345			If response = "ERROR" Then GoTo configError
346	pjm2	1.3	lastModified = response
347	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
348	pjm2	1.5	TCPSock.SendData "FILELIST" & vbCrLf
349	pjm2	1.2	Case 3:
350			If response = "ERROR" Then GoTo configError
351	pjm2	1.3	fileList = response
352	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
353	pjm2	1.29	TCPSock.SendData "FQDN" & vbCrLf
354			Case 4:
355			If response = "ERROR" Then GoTo configError
356			Text1.Text = Text1.Text & response & vbCrLf
357			machineName = response
358	pjm2	1.5	TCPSock.SendData "UDPUpdateTime" & vbCrLf
359	pjm2	1.29	Case 5:
360	pjm2	1.2	If response = "ERROR" Then GoTo configError
361	pjm2	1.7	UDPUpdateTime = response
362	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
363	pjm2	1.5	TCPSock.SendData "TCPUpdateTime" & vbCrLf
364	pjm2	1.29	Case 6:
365	pjm2	1.2	If response = "ERROR" Then GoTo configError
366	pjm2	1.7	TCPUpdateTime = response
367	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
368	pjm2	1.5	TCPSock.SendData "ENDCONFIG" & vbCrLf
369	pjm2	1.29	Case 7:
370	pjm2	1.2	If Not response = "OK" Then GoTo configError
371	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
372	pjm2	1.5	TCPSock.SendData "FILTER" & vbCrLf
373	pjm2	1.29	Case 8:
374	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
375	pjm2	1.39	' We got a filter list here.
376	pjm2	1.2	readTo = 0
377	pjm2	1.39	' Get hostname
378	pjm2	1.2	readTo = InStr(1, response, ";", vbBinaryCompare)
379			filterHostname = Mid(response, 1, readTo - 1)
380			response = Mid(response, readTo + 1, Len(response))
381	pjm2	1.39	' Get UDP Port number
382	pjm2	1.2	readTo = InStr(1, response, ";")
383			filterUDPPort = Mid(response, 1, readTo - 1)
384			response = Mid(response, readTo + 1, Len(response))
385	pjm2	1.39	' Get TCP Port number
386	pjm2	1.2	filterTCPPort = response
387	pjm2	1.5	TCPSock.SendData "END" & vbCrLf
388	pjm2	1.29	Case 9:
389	pjm2	1.2	If Not response = "OK" Then GoTo configError
390			connected = True
391			responseNumber = 0
392	pjm2	1.39	' We've finished with the socket now.
393	pjm2	1.5	TCPSock.Close
394	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
395	pjm2	1.10	Status.Caption = "Configuration successful"
396	pjm2	1.8	Label3.Caption = UDPUpdateTime
397			Label4.Caption = TCPUpdateTime
398			Timer1.Interval = 1000
399	pjm2	1.2	End Select
400			Else
401			' Perform a heartbeat (1.1)
402	pjm2	1.34	heartBeating = True
403	pjm2	1.2	On Error GoTo heartbeatError
404			Select Case responseNumber
405			Case 1:
406	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
407	pjm2	1.26	Text1.Text = "Performing heartbeat: -" & vbCrLf
408			Text1.Text = Text1.Text & response & vbCrLf
409	pjm2	1.5	TCPSock.SendData "CONFIG" & vbCrLf
410	pjm2	1.2	Case 2:
411	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
412	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
413	pjm2	1.5	TCPSock.SendData fileList & vbCrLf
414	pjm2	1.2	Case 3:
415	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
416	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
417	pjm2	1.5	TCPSock.SendData lastModified & vbCrLf
418	pjm2	1.2	Case 4:
419	pjm2	1.39	' Reconfigure if the server configuration for the
420			' host has been altered.
421	pjm2	1.34	If Not response = "OK" Then
422			heartBeating = False
423			Reconfigure_Click
424			End If
425	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
426	pjm2	1.5	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
427	pjm2	1.2	Case 5:
428	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
429	pjm2	1.26	Text1.Text = Text1.Text & response & vbCrLf
430	pjm2	1.5	TCPSock.Close
431	pjm2	1.10	Status.Caption = "Heartbeat sent successfully."
432	pjm2	1.39	heartBeating = False
433	pjm2	1.2	End Select
434
435			End If
436
437
438			Exit Sub
439
440			configError:
441	pjm2	1.34	heartBeating = False
442	pjm2	1.33	Status.Caption = "FAILED to get configuration from the server"
443	pjm2	1.8	Exit Sub
444	pjm2	1.2	heartbeatError:
445	pjm2	1.34	heartBeating = False
446	pjm2	1.10	Status.Caption = "Heatbeat FAILED"
447	pjm2	1.8	Exit Sub
448	pjm2	1.1	End Sub
449	pjm2	1.5
450	pjm2	1.39
451			' Deal with the construction and sending of UDP packets.
452	pjm2	1.8	Private Sub Timer1_Timer()
453
454			Label3.Caption = Label3.Caption - 1
455			Label4.Caption = Label4.Caption - 1
456
457	pjm2	1.10	Status.Caption = ""
458	pjm2	1.8
459			If Label3.Caption < 1 Then
460	pjm2	1.15
461			' prepare the contents of the XML packet.
462			seqNo = seqNo + 1
463	pjm2	1.26
464	pjm2	1.39	' Windows machines can provide their NetBIOS name to assist
465			' in identifying the machine.
466	pjm2	1.31	netbiosName = TCPSock.LocalHostName
467	pjm2	1.26
468	pjm2	1.39	' The I.P. address of the host machine.
469	pjm2	1.16	LocalIP = TCPSock.LocalIP
470	pjm2	1.39
471			' The date according to the host machine (formatted as the
472			' number of seconds since the epoch).
473	pjm2	1.14	packetDate = Date2Num()
474	pjm2	1.15
475	pjm2	1.39	' Attempt to return Windows version information with the API.
476	pjm2	1.15	Dim verinfo As OSVERSIONINFO
477			verinfo.dwOSVersionInfoSize = Len(verinfo)
478			ret% = GetVersionEx(verinfo)
479			If ret% = 0 Then
480	pjm2	1.39	Text1.Text = Text1.Text & vbCrLf & "Error getting Windows version Information"
481	pjm2	1.15	End
482			End If
483
484	pjm2	1.39	' Now get all of the version information.
485	pjm2	1.21	osName = GetVersion()
486	pjm2	1.15	osVersionMajor = verinfo.dwMajorVersion
487			osVersionMinor = verinfo.dwMinorVersion
488			osBuild = verinfo.dwBuildNumber
489
490	pjm2	1.39	' Find out what type of processor the host is using.
491	pjm2	1.15	Dim sysinfo As SYSTEM_INFO
492			GetSystemInfo sysinfo
493			Select Case sysinfo.dwProcessorType
494			Case PROCESSOR_INTEL_386
495			processorType = "Intel 386"
496			Case PROCESSOR_INTEL_486
497			processorType = "Intel 486"
498			Case PROCESSOR_INTEL_PENTIUM
499			processorType = "Intel Pentium variant"
500			Case PROCESSOR_MIPS_R4000
501			processorType = "MIPS R4000"
502			Case PROCESSOR_ALPHA_21064
503			processorType = "DEC Alpha 21064"
504			Case Else
505			processorType = "(unknown)"
506			End Select
507
508	pjm2	1.39	' Find the amount of swap memory and physical memory
509			' (both free and total)
510	pjm2	1.15	Dim memsts As MEMORYSTATUS
511			Dim memory&
512			GlobalMemoryStatus memsts
513			memory& = memsts.dwTotalPhys
514	pjm2	1.29	memTotal = memory& \ 1048576
515	pjm2	1.15	memory& = memsts.dwAvailPhys
516	pjm2	1.29	memFree = memory& \ 1048576
517	pjm2	1.15	memory& = memsts.dwTotalVirtual
518	pjm2	1.29	swapTotal = memory& \ 1048576
519	pjm2	1.15	memory& = memsts.dwAvailVirtual
520	pjm2	1.29	swapFree = memory& \ 1048576
521	pjm2	1.15
522	pjm2	1.39	' Cause the CUpTime class to capture its data.
523	pjm2	1.23	CUpTime.Capture
524	pjm2	1.39
525			' Get the processor occupancy percentages.
526	pjm2	1.23	cpu_time = CUpTime.CPUTime
527			percent_idle = CUpTime.PercentIdle
528	pjm2	1.32
529	pjm2	1.39	' Get the uptime for the host. DO NOT use integer division here,
530			' as this will cause the result to overflow if the machine has
531			' been up for more than ~47 days.
532	pjm2	1.33	uptime = CUpTime.MilliSecs / 1000#
533	pjm2	1.23
534	pjm2	1.39	' Use the CNetWksta class to find out how many users are logged
535			' on to the system.
536	pjm2	1.28	userCount = wksta.LoggedOnUsers
537
538	pjm2	1.15	' build the contents of the XML packet
539	pjm2	1.16	xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _
540	pjm2	1.15	"<os>" & _
541	pjm2	1.31	"<netbios_name>" & netbiosName & "</netbios_name>" & _
542	pjm2	1.15	"<name>" & osName & "</name>" & _
543	pjm2	1.35	"<version>" & osVersionMajor & "." & osVersionMinor & "</version>" & _
544	pjm2	1.15	"<release>" & osBuild & "</release>" & _
545	pjm2	1.36	"<platform>" & processorType & "</platform>" & _
546	pjm2	1.19	"<uptime>" & uptime & "</uptime>" & _
547	pjm2	1.15	"</os>" & _
548	pjm2	1.28	"<users><count>" & userCount & "</count></users>" & _
549	pjm2	1.23	"<cpu><idle>" & percent_idle & "</idle><user>" & cpu_time & "</user></cpu>" & _
550	pjm2	1.15	"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _
551			"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _
552	pjm2	1.17	"</packet>"
553	pjm2	1.39
554			' Show the interested user what we are sending.
555	pjm2	1.26	Text1.Text = "Last packet contained: -" & vbCrLf & xml
556	pjm2	1.8
557			' Use the first winsock control to send a UDP packet.
558			UDPSock.RemoteHost = filterHostname
559			UDPSock.RemotePort = filterUDPPort
560			UDPSock.SendData xml
561	pjm2	1.10	Status.Caption = "UDP packet sent"
562	pjm2	1.8	Label3.Caption = UDPUpdateTime
563			End If
564
565			If Label4.Caption < 1 Then
566			' establish a TCP connection to a filter
567			TCPSock.Close
568			TCPSock.Connect filterHostname, filterTCPPort
569			Label4.Caption = TCPUpdateTime
570			End If
571
572			End Sub
573	pjm2	1.13
574	pjm2	1.39
575			' Format the current date and time as a long integer representing
576			' the number of seconds since the epoch.
577	pjm2	1.13	Function Date2Num() As Long
578	pjm2	1.14	Dim x As Long
579			x = DateDiff("s", "1-1-1970", Now)
580			Date2Num = x
581	pjm2	1.13	End Function