--- experimental/host/vb_net_test/nettest.frm 2001/02/23 11:30:25 1.9 +++ experimental/host/vb_net_test/nettest.frm 2001/02/28 08:19:00 1.25 @@ -1,67 +1,60 @@ 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 = 1275 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 = 1275 + ScaleWidth = 4710 ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.Timer Timer1 - Left = 3840 - Top = 120 - End - Begin VB.CommandButton Command3 - Caption = "TCP to Filter" + StartUpPosition = 2 'CenterScreen + Visible = 0 'False + Begin VB.CommandButton Hide + Caption = "Hide Window" Height = 375 - Left = 3720 - TabIndex = 3 - Top = 2520 - Width = 1575 + Left = 3120 + TabIndex = 6 + Top = 480 + Width = 1455 End - Begin VB.TextBox Text4 - Height = 1575 - Left = 240 - MultiLine = -1 'True - ScrollBars = 2 'Vertical - TabIndex = 2 - Text = "nettest.frx":0000 - Top = 3000 - Width = 5055 + Begin SysTray.SystemTray SystemTray + Left = 2160 + Top = 1800 + _ExtentX = 847 + _ExtentY = 847 + SysTrayText = "i-scream Winhost" + IconFile = 0 End - Begin VB.CommandButton Command2 - Caption = "TCP to FilterManager" + Begin VB.Timer Timer1 + Left = 2760 + Top = 1800 + End + Begin VB.CommandButton Reconfigure + Caption = "Reconfigure with FilterManager" Height = 375 - Left = 3360 - TabIndex = 1 - Top = 2040 - Width = 1935 + Left = 120 + TabIndex = 0 + Top = 480 + Width = 2895 End Begin MSWinsockLib.Winsock TCPSock - Left = 4920 - Top = 120 + Left = 3720 + Top = 1800 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End - Begin VB.CommandButton Command1 - Caption = "Send UDP" - Height = 375 - Left = 4320 - TabIndex = 0 - Top = 1560 - Width = 975 - End Begin MSWinsockLib.Winsock UDPSock - Left = 4320 - Top = 120 + Left = 3240 + Top = 1800 _ExtentX = 741 _ExtentY = 741 _Version = 393216 @@ -71,9 +64,9 @@ Begin VB.Form Form1 Alignment = 1 'Right Justify Caption = "Next heartbeat:" Height = 255 - Left = 120 - TabIndex = 8 - Top = 480 + Left = 2400 + TabIndex = 5 + Top = 120 Width = 1455 End Begin VB.Label Label1 @@ -81,33 +74,36 @@ Begin VB.Form Form1 Caption = "Next UDP packet:" Height = 255 Left = 120 - TabIndex = 7 + TabIndex = 4 Top = 120 Width = 1455 End Begin VB.Label Label4 + BorderStyle = 1 'Fixed Single Caption = "0" Height = 255 - Left = 1680 - TabIndex = 6 - Top = 480 + Left = 3960 + TabIndex = 3 + Top = 120 Width = 615 End Begin VB.Label Label3 + BorderStyle = 1 'Fixed Single Caption = "0" Height = 255 Left = 1680 - TabIndex = 5 + TabIndex = 2 Top = 120 Width = 615 End Begin VB.Label Status + Alignment = 2 'Center Caption = "Status:" Height = 255 - Left = 120 - TabIndex = 4 - Top = 5280 - Width = 5415 + Left = 0 + TabIndex = 1 + Top = 960 + Width = 4695 End End Attribute VB_Name = "Form1" @@ -115,12 +111,16 @@ 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 filterManagerTCPPort As Long +Dim seqNo As Long +Dim machineName As String + Dim filterHostname As String Dim filterTCPPort As Integer Dim filterUDPPort As Integer @@ -132,65 +132,96 @@ Dim TCPUpdateTime As Integer Dim protocolVersion As String Dim connected As Boolean -Dim responseNumber As Integer +Dim CUpTime As New CUpTime +Dim wksta As New CNetWksta -Private Sub Command1_Click() +Dim responseNumber As Integer - ' build the contents of the XML packet. - xml = "" - - ' Use the first winsock control to send a UDP packet. - UDPSock.RemoteHost = filterHostname - UDPSock.RemotePort = filterUDPPort - UDPSock.SendData xml - Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent." - -End Sub - -Private Sub Command2_Click() - - ' establish a TCP connection to a filtermanager - TCPSock.Close - TCPSock.Connect filterManagerHostname, filterManagerTCPPort - -End Sub - -Private Sub Command3_Click() - ' establish a TCP connection to a filter - TCPSock.Close - TCPSock.Connect filterHostname, filterTCPPort -End Sub - Private Sub Form_Load() + + If App.PrevInstance Then + x = MsgBox("There is already an i-scream Winhost running on this machine.", 48, "i-scream host already running") + End + End If + protocolVersion = "1.1" - Status.Caption = "i-scream Winhost " & protocolVersion + Status.Caption = "Loading" + Form1.Caption = "i-scream Winhost " & protocolVersion + CUpTime.Init + + If CUpTime.isWin9x Then + x = MsgBox("Sorry, the i-scream host can only be used to monitor servers (i.e. not Win9x)", 48, "Not a server") + End + End If + ''''TEMP - filterManagerHostname = "killigrew.ukc.ac.uk" - filterManagerTCPPort = 4567 - Exit Sub - ''' ENDTEMP + '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", "", buf, Len(buf), App.Path & "winhost.ini") + length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "", buf, Len(buf), App.Path & "/winhost.ini") filterManagerHostname = Left$(buf, length) - length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "", buf, Len(buf), App.Path & "winhost.ini") - filterManagerTCPPort = 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 - Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager" + 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.", 48, "Configuration not found") + 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 @@ -216,7 +247,7 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo ' 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 If connected = False Then ' Perform TCP configuration (1.1) @@ -263,8 +294,8 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo connected = True responseNumber = 0 TCPSock.Close - Text4.Text = Text4.Text & vbCrLf & " " - Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay" + 'Text4.Text = Text4.Text & vbCrLf & " " + Status.Caption = "Configuration successful" Label3.Caption = UDPUpdateTime Label4.Caption = TCPUpdateTime Timer1.Interval = 1000 @@ -288,7 +319,7 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo Case 5: If Not response = "OK" Then GoTo heartbeatError TCPSock.Close - Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay." + Status.Caption = "Heartbeat sent successfully." End Select End If @@ -297,50 +328,99 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo Exit Sub configError: - Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration " & Err.Description + Status.Caption = "FAILED to get configuration" Exit Sub heartbeatError: - Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED " & Err.Description + Status.Caption = "Heatbeat FAILED" Exit Sub End Sub -Private Sub TCPTimer_Timer() - - ' establish a TCP connection to a filter - TCPSock.Close - TCPSock.Connect filterHostname, filterTCPPort - -End Sub - -Private Sub UDPTimer_Timer() - - ' build the contents of the XML packet. - xml = "" - - ' Use the first winsock control to send a UDP packet. - UDPSock.RemoteHost = filterHostname - UDPSock.RemotePort = filterUDPPort - UDPSock.SendData xml - Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent." - -End Sub - Private Sub Timer1_Timer() Label3.Caption = Label3.Caption - 1 Label4.Caption = Label4.Caption - 1 - Status.Caption = "i-scream Winhost " & protocolVersion + Status.Caption = "" If Label3.Caption < 1 Then - ' build the contents of the XML packet. - xml = "" + + ' prepare the contents of the XML packet. + seqNo = seqNo + 1 + machineName = TCPSock.LocalHostName + LocalIP = TCPSock.LocalIP + packetDate = Date2Num() + + + Dim verinfo As OSVERSIONINFO + verinfo.dwOSVersionInfoSize = Len(verinfo) + ret% = GetVersionEx(verinfo) + If ret% = 0 Then + MsgBox "Error getting Windows version Information" + End + End If + + osName = GetVersion() + osVersionMajor = verinfo.dwMajorVersion + osVersionMinor = verinfo.dwMinorVersion + osBuild = verinfo.dwBuildNumber + + Dim sysinfo As SYSTEM_INFO + GetSystemInfo sysinfo + Select Case sysinfo.dwProcessorType + Case PROCESSOR_INTEL_386 + processorType = "Intel 386" + Case PROCESSOR_INTEL_486 + processorType = "Intel 486" + Case PROCESSOR_INTEL_PENTIUM + processorType = "Intel Pentium variant" + Case PROCESSOR_MIPS_R4000 + processorType = "MIPS R4000" + Case PROCESSOR_ALPHA_21064 + processorType = "DEC Alpha 21064" + Case Else + processorType = "(unknown)" + End Select + + Dim memsts As MEMORYSTATUS + Dim memory& + GlobalMemoryStatus memsts + memory& = memsts.dwTotalPhys + memTotal = memory& \ 1024 + memory& = memsts.dwAvailPhys + memFree = memory& \ 1024 + memory& = memsts.dwTotalVirtual + swapTotal = memory& \ 1024 + memory& = memsts.dwAvailVirtual + swapFree = memory& \ 1024 + + uptime = CUpTime.MilliSecs \ 1000 + + CUpTime.Capture + cpu_time = CUpTime.CPUTime + percent_idle = CUpTime.PercentIdle + + ' build the contents of the XML packet + xml = "" & _ + "" & _ + "" & osName & "" & _ + "" & osVersionMajor & "" & _ + "" & osBuild & "" & _ + "" & osName & "" & _ + "" & osVersionMinor & "" & _ + "" & processorType & "" & _ + "" & uptime & "" & _ + "" & _ + "" & percent_idle & "" & cpu_time & "" & _ + "" & memTotal & "" & memFree & "" & _ + "" & swapTotal & "" & swapFree & "" & _ + "" + '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 = "i-scream Winhost " & protocolVersion & " - UDP packet sent." + Status.Caption = "UDP packet sent" Label3.Caption = UDPUpdateTime End If @@ -352,3 +432,9 @@ Private Sub Timer1_Timer() End If End Sub + +Function Date2Num() As Long + Dim x As Long + x = DateDiff("s", "1-1-1970", Now) + Date2Num = x +End Function