118 |
|
Attribute VB_Creatable = False |
119 |
|
Attribute VB_PredeclaredId = True |
120 |
|
Attribute VB_Exposed = False |
121 |
+ |
' For the system tray bits |
122 |
|
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 |
123 |
|
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 |
124 |
|
|
139 |
|
|
140 |
|
Dim protocolVersion As String |
141 |
|
Dim connected As Boolean |
142 |
+ |
|
143 |
+ |
'Dim CUpTime As New CUpTime |
144 |
+ |
|
145 |
|
Dim responseNumber As Integer |
146 |
|
|
147 |
|
Private Sub Form_Load() |
149 |
|
protocolVersion = "1.1" |
150 |
|
|
151 |
|
Status.Caption = "Loading" |
152 |
< |
Form1.Caption = "i-scream Winhost " & protocolVersion |
152 |
> |
'Form1.Caption = "i-scream Winhost " & protocolVersion & " for " & GetVersion() |
153 |
|
|
154 |
|
''''TEMP |
155 |
|
filterManagerHostname = "killigrew.ukc.ac.uk" |
169 |
|
Status.Caption = "Connecting to Filter Manager" |
170 |
|
Reconfigure_Click |
171 |
|
|
172 |
+ |
Form1.Show |
173 |
+ |
SystemTray.Action = 0 |
174 |
+ |
|
175 |
+ |
|
176 |
|
Exit Sub |
177 |
|
|
178 |
|
iniError: |
185 |
|
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") |
186 |
|
If x = 7 Then |
187 |
|
Cancel = True |
188 |
+ |
Else |
189 |
+ |
SystemTray.Action = 2 |
190 |
|
End If |
181 |
– |
SystemTray.Action = 2 |
191 |
|
|
192 |
|
End Sub |
193 |
|
|
194 |
|
Private Sub Hide_Click() |
195 |
|
Form1.Visible = False |
196 |
|
SystemTray.Icon = Val(Form1.Icon) |
188 |
– |
SystemTray.Action = 0 |
197 |
|
End Sub |
198 |
|
|
199 |
|
Private Sub Reconfigure_Click() |
208 |
|
Private Sub SystemTray_MouseDblClk(ByVal Button As Integer) |
209 |
|
|
210 |
|
Form1.Visible = True |
203 |
– |
SystemTray.Action = 2 |
211 |
|
Form1.SetFocus |
212 |
|
|
213 |
|
|
334 |
|
Status.Caption = "" |
335 |
|
|
336 |
|
If Label3.Caption < 1 Then |
337 |
< |
' build the contents of the XML packet. |
338 |
< |
localIP = TCPSock.localIP |
332 |
< |
machineName = TCPSock.LocalHostName |
337 |
> |
|
338 |
> |
' prepare the contents of the XML packet. |
339 |
|
seqNo = seqNo + 1 |
340 |
+ |
machineName = TCPSock.LocalHostName |
341 |
+ |
LocalIP = TCPSock.LocalIP |
342 |
|
packetDate = Date2Num() |
343 |
< |
xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & localIP & """>" & _ |
344 |
< |
"" & _ |
345 |
< |
"" & _ |
346 |
< |
"" & _ |
347 |
< |
"" & _ |
348 |
< |
"" & _ |
349 |
< |
"" & _ |
350 |
< |
"" & _ |
351 |
< |
"" & _ |
352 |
< |
"" & _ |
353 |
< |
"" & _ |
354 |
< |
"" & _ |
355 |
< |
"" & _ |
356 |
< |
"" & _ |
357 |
< |
"" & _ |
343 |
> |
|
344 |
> |
|
345 |
> |
Dim verinfo As OSVERSIONINFO |
346 |
> |
verinfo.dwOSVersionInfoSize = Len(verinfo) |
347 |
> |
ret% = GetVersionEx(verinfo) |
348 |
> |
If ret% = 0 Then |
349 |
> |
MsgBox "Error getting Windows version Information" |
350 |
> |
End |
351 |
> |
End If |
352 |
> |
|
353 |
> |
osName = getVersion() |
354 |
> |
osVersionMajor = verinfo.dwMajorVersion |
355 |
> |
osVersionMinor = verinfo.dwMinorVersion |
356 |
> |
osBuild = verinfo.dwBuildNumber |
357 |
> |
|
358 |
> |
Dim sysinfo As SYSTEM_INFO |
359 |
> |
GetSystemInfo sysinfo |
360 |
> |
Select Case sysinfo.dwProcessorType |
361 |
> |
Case PROCESSOR_INTEL_386 |
362 |
> |
processorType = "Intel 386" |
363 |
> |
Case PROCESSOR_INTEL_486 |
364 |
> |
processorType = "Intel 486" |
365 |
> |
Case PROCESSOR_INTEL_PENTIUM |
366 |
> |
processorType = "Intel Pentium variant" |
367 |
> |
Case PROCESSOR_MIPS_R4000 |
368 |
> |
processorType = "MIPS R4000" |
369 |
> |
Case PROCESSOR_ALPHA_21064 |
370 |
> |
processorType = "DEC Alpha 21064" |
371 |
> |
Case Else |
372 |
> |
processorType = "(unknown)" |
373 |
> |
End Select |
374 |
> |
|
375 |
> |
Dim memsts As MEMORYSTATUS |
376 |
> |
Dim memory& |
377 |
> |
GlobalMemoryStatus memsts |
378 |
> |
memory& = memsts.dwTotalPhys |
379 |
> |
memTotal = memory& \ 1024 |
380 |
> |
memory& = memsts.dwAvailPhys |
381 |
> |
memFree = memory& \ 1024 |
382 |
> |
memory& = memsts.dwTotalVirtual |
383 |
> |
swapTotal = memory& \ 1024 |
384 |
> |
memory& = memsts.dwAvailVirtual |
385 |
> |
swapFree = memory& \ 1024 |
386 |
> |
|
387 |
> |
' build the contents of the XML packet |
388 |
> |
xml = "<packet seq_no=""" & seqNo & """ machine_name=""" & machineName & """ date=""" & packetDate & """ type=""data"" ip=""" & LocalIP & """>" & _ |
389 |
> |
"<os>" & _ |
390 |
> |
"<name>" & osName & "</name>" & _ |
391 |
> |
"<version>" & osVersionMajor & "</version>" & _ |
392 |
> |
"<release>" & osBuild & "</release>" & _ |
393 |
> |
"<platform>" & osName & "</platform>" & _ |
394 |
> |
"<minor_version>" & osVersionMinor & "</minor_version>" & _ |
395 |
> |
"<processor>" & processorType & "</processor>" & _ |
396 |
> |
"</os>" & _ |
397 |
> |
"<memory><total>" & memTotal & "</total><free>" & memFree & "</free></memory>" & _ |
398 |
> |
"<swap><total>" & swapTotal & "</total><free>" & swapFree & "</free></swap>" & _ |
399 |
|
"" |
400 |
|
Text4.Text = Text4.Text + xml |
401 |
|
|