--- experimental/host/vb_net_test/nettest.frm 2001/02/23 13:27:09 1.14 +++ experimental/host/vb_net_test/nettest.frm 2001/02/26 09:23:34 1.21 @@ -2,14 +2,16 @@ 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 + BorderStyle = 3 'Fixed Dialog Caption = "i-scream Winhost" ClientHeight = 5655 ClientLeft = 45 - ClientTop = 285 + ClientTop = 330 ClientWidth = 4710 + Icon = "nettest.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False + MinButton = 0 'False ScaleHeight = 5655 ScaleWidth = 4710 ShowInTaskbar = 0 'False @@ -40,7 +42,7 @@ Begin VB.Form Form1 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 1 - Text = "nettest.frx":0000 + Text = "nettest.frx":0742 Top = 3000 Width = 3975 End @@ -67,6 +69,23 @@ Begin VB.Form Form1 _Version = 393216 Protocol = 1 End + Begin VB.Label Label5 + Caption = "b e t a" + BeginProperty Font + Name = "MS Sans Serif" + Size = 24 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 615 + Left = 240 + TabIndex = 8 + Top = 120 + Width = 1815 + End Begin VB.Label Label2 Alignment = 1 'Right Justify Caption = "Next heartbeat:" @@ -107,10 +126,10 @@ Begin VB.Form Form1 Alignment = 2 'Center Caption = "Status:" Height = 255 - Left = 120 + Left = 0 TabIndex = 2 Top = 1320 - Width = 4455 + Width = 4695 End End Attribute VB_Name = "Form1" @@ -118,11 +137,12 @@ 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 @@ -138,6 +158,9 @@ 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() @@ -147,28 +170,42 @@ Private Sub Form_Load() Status.Caption = "Loading" Form1.Caption = "i-scream Winhost " & protocolVersion + Form1.Show + + 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 + 'filterManagerHostname = "killigrew.ukc.ac.uk" + 'filterManagerTCPPort = 4567 ''''' END TEMP - GoTo skip + '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 + On Error GoTo 0 skip: - Status.Caption = "Connecting to Filter Manager" + 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.", 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 @@ -177,15 +214,15 @@ Private Sub Form_QueryUnload(Cancel As Integer, Unload 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 - SystemTray.Action = 2 End Sub Private Sub Hide_Click() Form1.Visible = False SystemTray.Icon = Val(Form1.Icon) - SystemTray.Action = 0 End Sub Private Sub Reconfigure_Click() @@ -200,7 +237,6 @@ End Sub Private Sub SystemTray_MouseDblClk(ByVal Button As Integer) Form1.Visible = True - SystemTray.Action = 2 Form1.SetFocus @@ -327,27 +363,72 @@ Private Sub Timer1_Timer() Status.Caption = "" If Label3.Caption < 1 Then - ' build the contents of the XML packet. - localIP = TCPSock.localIP - machineName = TCPSock.LocalHostName + + ' prepare the contents of the XML packet. seqNo = seqNo + 1 + machineName = TCPSock.LocalHostName + LocalIP = TCPSock.LocalIP packetDate = Date2Num() - xml = "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" & _ - "" + + + 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 = GetTickCount \ 1000 + + ' build the contents of the XML packet + xml = "" & _ + "" & _ + "" & osName & "" & _ + "" & osVersionMajor & "" & _ + "" & osBuild & "" & _ + "" & osName & "" & _ + "" & osVersionMinor & "" & _ + "" & processorType & "" & _ + "" & uptime & "" & _ + "" & _ + "" & memTotal & "" & memFree & "" & _ + "" & swapTotal & "" & swapFree & "" & _ + "" Text4.Text = Text4.Text + xml ' Use the first winsock control to send a UDP packet.