--- experimental/host/vb_net_test/nettest.frm 2001/02/23 12:01:14 1.12
+++ experimental/host/vb_net_test/nettest.frm 2001/02/23 17:31:44 1.16
@@ -118,12 +118,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 seqNo As Long
+Dim machineName As String
+
Dim filterHostname As String
Dim filterTCPPort As Integer
Dim filterUDPPort As Integer
@@ -135,42 +139,24 @@ Dim TCPUpdateTime As Integer
Dim protocolVersion As String
Dim connected As Boolean
-Dim responseNumber As Integer
+'Dim CUpTime As New CUpTime
-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 Command3_Click()
- ' establish a TCP connection to a filter
- TCPSock.Close
- TCPSock.Connect filterHostname, filterTCPPort
-End Sub
-
Private Sub Form_Load()
+
protocolVersion = "1.1"
-
+
Status.Caption = "Loading"
- Form1.Caption = "i-scream Winhost " & protocolVersion
+ 'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion()
''''TEMP
filterManagerHostname = "killigrew.ukc.ac.uk"
filterManagerTCPPort = 4567
- Reconfigure_Click
- Exit Sub
- ''' ENDTEMP
+ ''''' END TEMP
+ GoTo skip
On Error GoTo iniError
Dim buf As String * 256
Dim length As Long
@@ -178,9 +164,15 @@ Private Sub Form_Load()
filterManagerHostname = Left$(buf, length)
length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "", buf, Len(buf), App.Path & "winhost.ini")
filterManagerTCPPort = Left$(buf, length)
-
+skip:
+
Status.Caption = "Connecting to Filter Manager"
+ Reconfigure_Click
+ Form1.Show
+ SystemTray.Action = 0
+
+
Exit Sub
iniError:
@@ -193,15 +185,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()
@@ -216,7 +208,6 @@ End Sub
Private Sub SystemTray_MouseDblClk(ByVal Button As Integer)
Form1.Visible = True
- SystemTray.Action = 2
Form1.SetFocus
@@ -343,8 +334,70 @@ 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
+ 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
+
+ ' build the contents of the XML packet
+ xml = "" & _
+ "" & _
+ "" & osName & "" & _
+ "" & osVersionMajor & "" & _
+ "" & osBuild & "" & _
+ "" & osName & "" & _
+ "" & osVersionMinor & "" & _
+ "" & processorType & "" & _
+ "" & _
+ "" & memTotal & "" & memFree & "" & _
+ "" & swapTotal & "" & swapFree & "" & _
+ ""
+ Text4.Text = Text4.Text + xml
' Use the first winsock control to send a UDP packet.
UDPSock.RemoteHost = filterHostname
@@ -362,3 +415,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