--- projects/cms/source/host/winhost/nettest.frm 2001/02/28 09:18:26 1.27 +++ projects/cms/source/host/winhost/nettest.frm 2001/03/19 09:35:56 1.35 @@ -139,17 +139,22 @@ Dim filterManagerTCPPort As Long Dim seqNo As Long Dim machineName As String +Dim secondsRunning As Long + Dim filterHostname As String Dim filterTCPPort As Integer Dim filterUDPPort As Integer Dim fileList As String Dim lastModified As String +Dim fourtySevenDays As Integer + Dim UDPUpdateTime As Integer Dim TCPUpdateTime As Integer Dim protocolVersion As String Dim connected As Boolean +Dim heartBeating As Boolean Dim CUpTime As New CUpTime Dim wksta As New CNetWksta @@ -179,6 +184,9 @@ Private Sub Form_Load() End End If + ' Assume the host is run within the first 47 days of the machine starting. + fourtySevenDays = 0 + protocolVersion = "1.1" Status.Caption = "Loading" @@ -242,11 +250,16 @@ Private Sub Hide_Click() 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 + If Not heartBeating Then + connected = False + TCPSock.Close + TCPSock.Connect filterManagerHostname, filterManagerTCPPort + Else + Status.Caption = "Cannot reconfigure while heartbeating" + End If End Sub @@ -283,7 +296,6 @@ 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 If connected = False Then ' Perform TCP configuration (1.1) @@ -299,34 +311,32 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo 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 + ' New addition to the protocol. 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 + 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 5: + Case 6: If response = "ERROR" Then GoTo configError TCPUpdateTime = response Text1.Text = Text1.Text & response & vbCrLf TCPSock.SendData "ENDCONFIG" & vbCrLf - Case 6: + Case 7: If Not response = "OK" Then GoTo configError Text1.Text = Text1.Text & response & vbCrLf TCPSock.SendData "FILTER" & vbCrLf - Case 7: + Case 8: Text1.Text = Text1.Text & response & vbCrLf 'we got a filter list here. readTo = 0 @@ -341,7 +351,7 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo ' get TCP Port number filterTCPPort = response TCPSock.SendData "END" & vbCrLf - Case 8: + Case 9: If Not response = "OK" Then GoTo configError connected = True responseNumber = 0 @@ -355,6 +365,7 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo End Select Else ' Perform a heartbeat (1.1) + heartBeating = True On Error GoTo heartbeatError Select Case responseNumber Case 1: @@ -371,7 +382,10 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo Text1.Text = Text1.Text & response & vbCrLf TCPSock.SendData lastModified & vbCrLf Case 4: - If Not response = "OK" Then GoTo heartbeatError + If Not response = "OK" Then + heartBeating = False + Reconfigure_Click + End If Text1.Text = Text1.Text & response & vbCrLf TCPSock.SendData "ENDHEARTBEAT" & vbCrLf Case 5: @@ -387,9 +401,11 @@ Private Sub TCPSock_DataArrival(ByVal bytesTotal As Lo Exit Sub configError: - Status.Caption = "FAILED to get configuration" + heartBeating = False + Status.Caption = "FAILED to get configuration from the server" Exit Sub heartbeatError: + heartBeating = False Status.Caption = "Heatbeat FAILED" Exit Sub End Sub @@ -406,8 +422,7 @@ Private Sub Timer1_Timer() ' prepare the contents of the XML packet. seqNo = seqNo + 1 - ' Comment this line in the next protocol - machineName = TCPSock.LocalHostName + netbiosName = TCPSock.LocalHostName LocalIP = TCPSock.LocalIP packetDate = Date2Num() @@ -447,31 +462,40 @@ Private Sub Timer1_Timer() Dim memory& GlobalMemoryStatus memsts memory& = memsts.dwTotalPhys - memTotal = memory& \ 1024 + memTotal = memory& \ 1048576 memory& = memsts.dwAvailPhys - memFree = memory& \ 1024 + memFree = memory& \ 1048576 memory& = memsts.dwTotalVirtual - swapTotal = memory& \ 1024 + swapTotal = memory& \ 1048576 memory& = memsts.dwAvailVirtual - swapFree = memory& \ 1024 + swapFree = memory& \ 1048576 - uptime = CUpTime.MilliSecs \ 1000 - CUpTime.Capture cpu_time = CUpTime.CPUTime percent_idle = CUpTime.PercentIdle + '' Doesn't work after 47 days :-/ + 'uptime = GetTickCount \ 1000 + + 'secondsRunning = secondsRunning + UDPUpdateTime + 'uptime = secondsRunning + + uptime = CUpTime.MilliSecs / 1000# + + userCount = wksta.LoggedOnUsers + ' build the contents of the XML packet xml = "" & _ "" & _ + "" & netbiosName & "" & _ "" & osName & "" & _ - "" & osVersionMajor & "" & _ + "" & osVersionMajor & "." & osVersionMinor & "" & _ "" & osBuild & "" & _ "" & osName & "" & _ - "" & osVersionMinor & "" & _ - "" & processorType & "" & _ + "" & processorType & "" & _ "" & uptime & "" & _ "" & _ + "" & userCount & "" & _ "" & percent_idle & "" & cpu_time & "" & _ "" & memTotal & "" & memFree & "" & _ "" & swapTotal & "" & swapFree & "" & _