--- experimental/host/vb_net_test/nettest.frm 2001/02/23 11:56:43 1.11
+++ 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
- ClientWidth = 5670
+ ClientTop = 330
+ ClientWidth = 4710
+ Icon = "nettest.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
- ScaleHeight = 5655
- ScaleWidth = 5670
+ MinButton = 0 'False
+ ScaleHeight = 1185
+ ScaleWidth = 4710
ShowInTaskbar = 0 'False
- StartUpPosition = 3 'Windows Default
- Begin VB.CommandButton Hide
- Caption = "Hide"
- Height = 495
- Left = 1800
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton Command1
+ Caption = "more"
+ Height = 255
+ Left = 3960
+ TabIndex = 8
+ Top = 840
+ Width = 615
+ End
+ Begin VB.TextBox Text1
+ Height = 2055
+ Left = 120
+ Locked = -1 'True
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
TabIndex = 7
- Top = 2160
- Width = 1215
+ 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 = 3600
- Top = 1200
+ Left = 2520
+ Top = 4200
_ExtentX = 847
_ExtentY = 847
SysTrayText = "i-scream Winhost"
IconFile = 0
End
Begin VB.Timer Timer1
- Left = 4200
- Top = 1200
+ 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 = 5055
- End
Begin VB.CommandButton Reconfigure
Caption = "Reconfigure with FilterManager"
- Height = 495
- Left = 120
+ Height = 375
+ Left = 840
TabIndex = 0
- Top = 120
+ Top = 3480
Width = 2895
End
Begin MSWinsockLib.Winsock TCPSock
- Left = 5160
- Top = 1200
+ Left = 4080
+ Top = 4200
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock UDPSock
- Left = 4680
- Top = 1200
+ 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 = 3360
- 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 = 3360
- 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 = 4920
- TabIndex = 4
+ Left = 1680
+ TabIndex = 3
Top = 480
Width = 615
End
@@ -98,18 +109,19 @@ Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "0"
Height = 255
- Left = 4920
- TabIndex = 3
+ Left = 1680
+ TabIndex = 2
Top = 120
Width = 615
End
Begin VB.Label Status
+ Alignment = 2 'Center
Caption = "Status:"
Height = 255
- Left = 120
- TabIndex = 2
+ Left = 0
+ TabIndex = 1
Top = 840
- Width = 5415
+ Width = 3855
End
End
Attribute VB_Name = "Form1"
@@ -117,12 +129,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
@@ -134,56 +150,79 @@ 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 windowBig As Boolean
- ' build the contents of the XML packet.
- xml = ""
+Dim responseNumber As Integer
- ' 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."
+Private Sub Command1_Click()
-End Sub
+ ' Toggle visibility of the debug output.
+ If windowBig Then
+ Form1.Height = 1500
+ windowBig = False
+ Else
+ Form1.Height = 4350
+ windowBig = True
+ End If
-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 = "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
+
+ windowBig = False
+
''''TEMP
- filterManagerHostname = "killigrew.ukc.ac.uk"
- filterManagerTCPPort = 4567
- Reconfigure_Click
- 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 = "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
@@ -192,6 +231,8 @@ 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
End Sub
@@ -199,7 +240,6 @@ End Sub
Private Sub Hide_Click()
Form1.Visible = False
SystemTray.Icon = Val(Form1.Icon)
- SystemTray.Action = 0
End Sub
Private Sub Reconfigure_Click()
@@ -243,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)
@@ -252,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
@@ -290,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
@@ -302,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
@@ -339,8 +402,81 @@ Private Sub Timer1_Timer()
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
+
+ ' Comment this line in the next protocol
+ 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 & "" & _
+ ""
+ Text1.Text = "Last packet contained: -" & vbCrLf & xml
' Use the first winsock control to send a UDP packet.
UDPSock.RemoteHost = filterHostname
@@ -358,3 +494,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