--- experimental/host/vb_net_test/nettest.frm 2001/02/23 17:31:44 1.16 +++ experimental/host/vb_net_test/nettest.frm 2001/02/28 09:18:26 1.27 @@ -2,66 +2,77 @@ 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 + ClientHeight = 1185 ClientLeft = 45 - ClientTop = 285 + ClientTop = 330 ClientWidth = 4710 + Icon = "nettest.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False - ScaleHeight = 5655 + MinButton = 0 'False + ScaleHeight = 1185 ScaleWidth = 4710 ShowInTaskbar = 0 'False - StartUpPosition = 3 'Windows Default - Begin VB.CommandButton Hide - Caption = "Hide Window" - Height = 375 - Left = 3120 - TabIndex = 7 + StartUpPosition = 2 'CenterScreen + Visible = 0 'False + Begin VB.CommandButton Command1 + Caption = "more" + Height = 255 + Left = 3960 + TabIndex = 8 Top = 840 - Width = 1455 + Width = 615 End + Begin VB.TextBox Text1 + Height = 2055 + Left = 120 + Locked = -1 'True + MultiLine = -1 'True + ScrollBars = 2 'Vertical + TabIndex = 7 + Top = 1200 + Width = 4455 + End + Begin VB.CommandButton Hide + Caption = "hide" + Height = 255 + Left = 3960 + TabIndex = 6 + Top = 480 + Width = 615 + End Begin SysTray.SystemTray SystemTray - Left = 2160 - Top = 1800 + Left = 2520 + Top = 4200 _ExtentX = 847 _ExtentY = 847 SysTrayText = "i-scream Winhost" IconFile = 0 End Begin VB.Timer Timer1 - Left = 2760 - Top = 1800 + Left = 3120 + Top = 4200 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 + Left = 840 TabIndex = 0 - Top = 840 + Top = 3480 Width = 2895 End Begin MSWinsockLib.Winsock TCPSock - Left = 3720 - Top = 1800 + Left = 4080 + Top = 4200 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin MSWinsockLib.Winsock UDPSock - Left = 3240 - Top = 1800 + Left = 3600 + Top = 4200 _ExtentX = 741 _ExtentY = 741 _Version = 393216 @@ -71,8 +82,8 @@ Begin VB.Form Form1 Alignment = 1 'Right Justify Caption = "Next heartbeat:" Height = 255 - Left = 2400 - TabIndex = 6 + Left = 120 + TabIndex = 5 Top = 480 Width = 1455 End @@ -80,8 +91,8 @@ Begin VB.Form Form1 Alignment = 1 'Right Justify Caption = "Next UDP packet:" Height = 255 - Left = 2400 - TabIndex = 5 + Left = 120 + TabIndex = 4 Top = 120 Width = 1455 End @@ -89,8 +100,8 @@ Begin VB.Form Form1 BorderStyle = 1 'Fixed Single Caption = "0" Height = 255 - Left = 3960 - TabIndex = 4 + Left = 1680 + TabIndex = 3 Top = 480 Width = 615 End @@ -98,8 +109,8 @@ Begin VB.Form Form1 BorderStyle = 1 'Fixed Single Caption = "0" Height = 255 - Left = 3960 - TabIndex = 3 + Left = 1680 + TabIndex = 2 Top = 120 Width = 615 End @@ -107,10 +118,10 @@ Begin VB.Form Form1 Alignment = 2 'Center Caption = "Status:" Height = 255 - Left = 120 - TabIndex = 2 - Top = 1320 - Width = 4455 + Left = 0 + TabIndex = 1 + Top = 840 + Width = 3855 End End Attribute VB_Name = "Form1" @@ -123,7 +134,7 @@ Private Declare Function GetPrivateProfileString Lib " 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 @@ -140,43 +151,78 @@ Dim TCPUpdateTime As Integer Dim protocolVersion As String Dim connected As Boolean -'Dim CUpTime As New CUpTime +Dim CUpTime As New CUpTime +Dim wksta As New CNetWksta +Dim windowBig As Boolean + Dim responseNumber As Integer +Private Sub Command1_Click() + + ' 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 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 = "Loading" - 'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion() + 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 + '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 + If filterManagerHostname = "" Then + GoTo iniError + End If + On Error GoTo 0 skip: - Status.Caption = "Connecting to Filter Manager" + Status.Caption = "Connecting to Filter Manager " & filterManagerHostname & ":" & filterManagerTCPPort Reconfigure_Click - Form1.Show + 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 @@ -209,7 +255,6 @@ Private Sub SystemTray_MouseDblClk(ByVal Button As Int Form1.Visible = True Form1.SetFocus - End Sub @@ -238,7 +283,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) @@ -247,26 +292,42 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo 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 @@ -285,7 +346,8 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo connected = True responseNumber = 0 TCPSock.Close - Text4.Text = Text4.Text & vbCrLf & " " + Text1.Text = Text1.Text & response & vbCrLf + 'Text4.Text = Text4.Text & vbCrLf & " " Status.Caption = "Configuration successful" Label3.Caption = UDPUpdateTime Label4.Caption = TCPUpdateTime @@ -297,18 +359,24 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo 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 @@ -337,7 +405,10 @@ Private Sub Timer1_Timer() ' 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() @@ -350,7 +421,7 @@ Private Sub Timer1_Timer() End End If - osName = getVersion() + osName = GetVersion() osVersionMajor = verinfo.dwMajorVersion osVersionMinor = verinfo.dwMinorVersion osBuild = verinfo.dwBuildNumber @@ -384,6 +455,12 @@ Private Sub Timer1_Timer() 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 = "" & _ "" & _ @@ -393,11 +470,13 @@ Private Sub Timer1_Timer() "" & osName & "" & _ "" & osVersionMinor & "" & _ "" & processorType & "" & _ + "" & uptime & "" & _ "" & _ + "" & percent_idle & "" & cpu_time & "" & _ "" & memTotal & "" & memFree & "" & _ "" & swapTotal & "" & swapFree & "" & _ - "" - Text4.Text = Text4.Text + xml + "" + Text1.Text = "Last packet contained: -" & vbCrLf & xml ' Use the first winsock control to send a UDP packet. UDPSock.RemoteHost = filterHostname