Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
fbSysMon v.2.0
| Uploader: |  csde_rats |
| Datum/Zeit: | 10.07.2008 22:06:10 |
/'
fbSysMon
(c) 2007 28398 Laboratories
http://28398.ath.cx/
'/
#Include "crt.bi"
Dim As Integer logo(0 To 48*4) => { _
_ 'f
24,24,35,77, _
18,42,41,47, _
18,72,41,77, _
30,18,47,23, _
42,24,53,29, _
48,30,53,35, _
_ 'b
66,19,71,23, _
72,19,83,77, _
84,36,95,41, _
90,42,101,47, _
96,48,107,71, _
84,72,101,77, _
_ 'S
120,18,149,23, _
144,24,155,35, _
114,24,125,35, _
120,36,131,41, _
126,42,143,47, _
138,48,149,53, _
144,54,155,71, _
114,61,125,71, _
120,72,149,77, _
_ 'y
162,36,173,71, _
168,72,191,77, _
192,36,203,83, _
186,84,197,89, _
162,90,191,95, _
_ 's
216,36,245,41, _
210,42,221,47, _
240,42,251,47, _
216,48,227,53, _
222,54,239,59, _
234,60,245,65, _
240,66,251,71, _
210,66,221,71, _
216,72,245,77, _
_ 'M
258,18,269,77, _
288,18,299,77, _
270,24,275,41, _
282,24,287,41, _
276,30,281,47, _
_ 'o
312,36,341,41, _
306,42,317,71, _
336,42,347,71, _
312,72,341,77, _
_ 'n
354,36,365,41, _
372,36,389,41, _
360,42,371,77, _
384,42,395,77 _
}
Dim Shared As ZString Ptr _HRPBegin 'Pointer auf den Anfang des Files
Dim Shared As Uinteger _HRPLen 'Länge des Files
Asm
.balign 16
jmp START_OF_PROG 'springe zum Label START_OF_PROG
.balign 4
START_OF_FILE: 'ab hier beginnt die eingebundene Datei
.incbin "./fbSysMon_raw.html"
END_OF_FILE: 'hier endet die eingebundene Datei
.balign 16
START_OF_PROG:
lea ebx, START_OF_FILE 'Lade die Adresse des Label START_OF_FILE nach ebx
mov dword Ptr [_HRPBegin], ebx 'Speicher die Adresse im Pointer StartFile
lea eax, END_OF_FILE 'Lade die Adresse des Label END_OF_FILE nach eax
sub eax, ebx 'berechne eax - ebx = Länge des Files
mov dword Ptr [_HRPLen], eax 'Speicher die Länge des Files in der Variablen LenFile
End Asm
' Farben
#Define White RGB(255, 255, 255)
#Define Grey200 RGB(200, 200, 200)
#Define Grey150 RGB(150, 150, 150)
#Define Grey100 RGB(100, 100, 100)
#Define Grey50 RGB(50 , 50, 50)
#Define Black RGB(0 , 0 , 0 )
#Define cRed RGB(255, 0 , 0 )
#Define cGreen RGB(0 , 255, 0 )
#Define cBlue RGB(0 , 0 , 255)
#Define Yellow RGB(255, 255, 0 )
#Define Tuerkese RGB(0 , 255, 255)
#Define Lila RGB(255, 0 , 255)
' Style
#Define Title_Active cBlue
#Define Title_Active_Font White
#Define Font_Color Yellow
#Define ByteToMB(x) (x/1024)/1024
Const XDiff = 320
Const XField = 35
Const XField2 = XField + XDiff
Const XVal = 152 '160 '179
Const XVal2 = XVal + XDiff
Type Mem
PhysTotal As UInteger ' In MB!!!
PhysAvail As UInteger
Phys_Used As UInteger
PhyShared As UInteger
PhyBuffer As UInteger
SwapTotal As UInteger
SwapAvail As UInteger
Swap_Used As UInteger
End Type
Type Res
ubBPP As UByte
sBPP As String
sRes As String
End Type
Type Alg
CPU As Double
Sys As String
Runtime As String
End Type
Type CPU
sBrand As String
sVendor As String
sSpeed As String
sNumCores As String
sArch As String
sFamily As String
sModel As String
sStepping As String
sh3DNow As String = "No"
sh3DNowEx As String = "No"
shMMX As String = "No"
shMMXEx As String = "No"
shSSE As String = "No"
shSSE2 As String = "No"
shSSE3 As String = "No"
shSSSE3 As String = "No"
shSSE41 As String = "No"
shSSE42 As String = "No"
shSSE4a As String = "No"
shSSE5 As String = "No"
shVMX As String = "No"
End Type
Dim Shared MemInf As Mem
Dim Shared ResInf As Res
Dim Shared AlgInf As Alg
Dim Shared CPUInf As CPU
#Ifdef __FB_WIN32__
#Define WIN_INCLUDEALL
#Include "windows.bi"
Function GetWindowsVersion () As String
Dim r As String
Dim viOS As OSVERSIONINFO
viOS.dwOSVersionInfoSize = SizeOf(OSVERSIONINFO)
GetVersionEx(@viOS)
Select Case viOS.dwPlatformId
Case VER_PLATFORM_WIN32_NT
If (viOS.dwMajorVersion = 6) And (viOS.dwMinorVersion > 0) Then r = "Windows Vista"
If (viOS.dwMajorVersion = 5) And (viOS.dwMinorVersion = 2) Then r = "Windows Server 2003"
If (viOS.dwMajorVersion = 5) And (viOS.dwMinorVersion = 1) Then r = "Windows XP"
If (viOS.dwMajorVersion = 5) And (viOS.dwMinorVersion = 0) Then r = "Windows 2000"
If viOS.dwMajorVersion <= 4 Then r = "Windows NT"
Case VER_PLATFORM_WIN32_WINDOWS
If (viOS.dwMajorVersion = 4) And (viOS.dwMinorVersion = 0) Then r = "Windows 95"
If (viOS.dwMajorVersion = 4) And (viOS.dwMinorVersion = 10) Then
If viOS.szCSDVersion = "A" Then r = " Windows 98 SE" Else r = "Windows 98"
EndIf
If (viOS.dwMajorVersion = 4) And (viOS.dwMinorVersion = 90) Then r = "Windows ME"
Case VER_PLATFORM_WIN32s
r = "Win32s"
End Select
Return r
End Function
#Else
Type sysinfo
uptime As Integer
loads(2) As Integer
totalram As Integer
freeram As Integer
sharedram As Integer
bufferram As Integer
totalswap As Integer
freeswap As Integer
procs As Short
reserved1 As Integer '4 bytes reserved
reserved2 As Integer '8 bytes reserved
reserved3 As Integer '12 bytes reserved
reserved4 As Integer '16 bytes reserved
reserved5 As Integer '20 bytes reserved
reserved6 As Integer '24 bytes reserved
End Type
Declare Function sysinfo Cdecl Alias "sysinfo" (ByRef return As sysinfo) As Integer
#EndIf
Function GetArch () As String
Select Case (fb_CpuDetect Shr 28)
Case 3: Return "i386"
Case 4: Return "i486"
Case 5: Return "i586"
Case 6: Return "i686"
End Select
End Function
Function has_CPUID () As Integer
'FB arbeitet auch noch auf Prozessoren die keine CPUID unterstützen!
'prüfen ob der Prozessor eine lesbare CPUID hat
Asm
pushfd ' Save EFLAGS auf den stack
pop eax ' Store EFLAGS in EAX
mov ebx, eax ' Save in EBX
xor eax, &h200000 ' bit 21 wechseln
push eax ' auf den stack
popfd ' in die EFLAGS
pushfd ' Push EFLAGS auf den stack
pop eax ' EFLAGS in EAX
cmp eax, ebx ' bleibt bit 21 geändert
jz no_cpuid ' hat keine CPUID
mov eax,1
no_cpuid:
mov [Function], eax
End Asm
End Function
Function GetCPUClock () As Integer
'Prozessortakt wird nicht immer richtig angezeigt?
Dim As Uinteger t
Dim As Double t1
#Ifdef __FB_WIN32__
SetPriorityClass (GetCurrentProcess(), REALTIME_PRIORITY_CLASS)
#EndIf
Asm
xor eax, eax
cpuid
rdtsc 'internen Clockcounter lesen
mov [t], eax
End Asm
t1 = Timer + 0.2 '20ms warten
Do: Loop Until t1 < Timer
Asm
xor eax, eax
cpuid
rdtsc 'internen Clockcounter lesen
Sub eax, [t] 'ersten Wert abziehen
mov ecx, 2000000
cdq
idiv ecx 'in Mhz wandeln
inc eax
imul eax, 10 'Anzeigewert glaetten
mov [Function], eax
End Asm
#Ifdef __FB_WIN32__
SetPriorityClass (GetCurrentProcess(), NORMAL_PRIORITY_CLASS)
#EndIf
End Function
Function has_MMX () As Byte
Dim As Byte hat_mmx = 0
Asm
mov eax, 1
cpuid
test edx, &h00800000 'hat_mmx, Bit 23
jz doesnot
mov Byte Ptr [hat_mmx], 1
doesnot:
End Asm
Return hat_mmx
End Function
Function has_SSE () As Byte
Dim As Byte hat_sse = 0
Asm
mov eax, 1
cpuid
test edx, &h02000000 'hat_sse, Bit 25
jz doesnot2
mov Byte Ptr [hat_sse], 1
doesnot2:
End Asm
Return hat_sse
End Function
Function has_SSE2 () As Byte
Dim As Byte hat_sse2 = 0
Asm
mov eax, 1
cpuid
test edx, &h04000000 'hat_sse2, Bit 26
jz doesnot3
mov Byte Ptr [hat_sse2], 1
doesnot3:
End Asm
Return hat_sse2
End Function
Function is_AMD () As Byte
Dim As Byte _is_amd, is_intel
Asm
mov eax, 0
cpuid
cmp ecx, &h444d4163 'cAMD
jnz no_amd
mov Byte Ptr [_is_amd], 1
no_amd:
cmp ecx, &h6c65746e 'ntel
jnz no_intel
mov Byte Ptr [is_intel], 1
no_intel:
End Asm
If _is_AMD = 0 Then Return 0 Else Return 1
End Function
Function is_x64 () As Byte
Dim As UInteger erg
Dim As Byte AMD64
If is_AMD = 1 Then
'Test auf extended functions
Asm
mov eax,&h80000000
cpuid
and eax, &h0F
mov [erg], eax
End Asm
If erg > 0 Then
Asm
mov eax,&h80000001
cpuid
test edx, &h20000000 'hat AMD64
jz weiter5
mov Byte Ptr [AMD64], 1
weiter5:
End Asm
End If
Else ' Intel
Asm
mov eax,&h80000000
cpuid
and eax, &h0F
mov [erg], eax
End Asm
If erg > 0 Then
Asm
mov eax,&h80000001
cpuid
test edx, &h20000000 'Intel 64bit
jz no_EM64T
mov Byte Ptr [AMD64], 1 ' nicht ganz richtig, ist aber im grunde dasselbe
no_EM64T:
End Asm
End If
End If
Return AMD64
End Function
Function _GetCoreCountAMD () As Byte
Dim As UInteger erg, tmp
Dim As Byte mnc, cores
Asm
mov eax, &h80000000
cpuid
And eax, &h0fffffff
mov [erg], eax
End Asm
Asm
mov eax,&h80000008
cpuid
mov [mnc], cl
Shr ecx,12
And ecx,15
mov [tmp],ecx
End Asm
If tmp=0 Then
cores=mnc+1
Else
cores=(1 shl tmp)
EndIf
Return cores
End Function
Function _GetCoreCountIntel () As Byte
Dim As Integer erg
Dim As UInteger tmp, tmp1, tmp2
Dim As Byte HTT
Asm
mov eax, 1
cpuid
mov [tmp], edx
End Asm
If tmp And &h10000000 Then HTT = 1 'Bit 28???
tmp = 0 ' don't forgot...
Asm
mov eax, 0
cpuid
mov [erg], eax
End Asm
Asm
mov eax, 1
cpuid
mov [tmp], ecx
Shr ebx, 16
And ebx, &h0ff
mov [tmp2], ebx '=CPUID(1).EBX[23:16] LogicalProcessorCount
End Asm
If tmp2 > 1 Then 'IF (CPUID(1).EBX[23:16] > 1)
If HTT = 1 Then
If erg >= 4 Then 'CPUID(0).EAX >= 4
Asm
mov eax, 4
mov ecx, 0
cpuid
Shr eax, 26
And eax, &h3F
Inc eax
mov [tmp], eax '(EAX[31:26] + 1) corcount
End Asm
If tmp2\tmp < 2 Then HTT = 0
EndIf
Return Cast(Byte, tmp2)
EndIf
EndIf
Return 1
End Function
Function readVendorName () As String
Dim _e As UInteger
Dim vendor As String * 12
Asm
mov eax, 0
cpuid
mov [_e], eax
mov [vendor], ebx 'vendor String 12 Byte
mov [vendor+4], edx
mov [vendor+8], ecx
End Asm
Return vendor
End Function
Function readBrandString () As String
Dim Brand As String * 48
Asm
mov eax, &H80000002 'Brand String 48Byte
cpuid
cmp eax, 0
jz no_brand
mov [Brand], eax
mov [Brand+4], ebx
mov [Brand+8], ecx
mov [Brand+12], edx
mov eax, &H80000003
cpuid
mov [Brand+16], eax
mov [Brand+20], ebx
mov [Brand+24], ecx
mov [Brand+28], edx
mov eax, &H80000004
cpuid
mov [Brand+32], eax
mov [Brand+36], ebx
mov [Brand+40], ecx
mov [Brand+44], edx
no_brand:
End Asm
Return Brand
End Function
Function getStepping () As Byte
Dim As Byte Stepping
Asm
mov eax, 1
cpuid
mov ebx, eax
and eax, &h0F
mov [Stepping], al '0-3 Stepping
End Asm
Return Stepping
End Function
Function getModel () As Byte
Dim As Byte Model
Asm
mov eax, 1
cpuid
mov eax,ebx
shr eax, 4
and eax, &h0F
mov [Model], al '4-7 Model
End Asm
Return Model
End Function
Function getFamily () As Byte
Dim As Byte Family
Asm
mov eax, 1
cpuid
mov eax,ebx
shr eax, 8
and eax, &h0F
mov [Family], al '8-11 Family
End Asm
Return Family
End Function
Function Replace (Byval StrEx as String, _
Byval StrMask as String, _
Byval StrRplce as String) as String
If Len(StrEx)=0 or Len(StrMask)>Len(StrEx) Then Return StrEx
Dim Buffer as String=StrEx
Dim MaskSearch as UInteger
Dim MFound as byte
Dim lp as UInteger=1
Do
MaskSearch=InStr(lp,Buffer,StrMask)
MFound=0
If MaskSearch Then
MFound=1:lp=MaskSearch+Len(StrRplce)
''
Buffer=Left(Buffer,MaskSearch-1)+ _
StrRplce+ _
Right(Buffer,Len(Buffer)-(MaskSearch+(Len(StrMask)-1)))
''
End If
Loop while MFound=1
Return Buffer
End Function
#Define YesToSPR(t) *IIf(t = "Yes", @"supported", @"not supported")
Sub CollectInfoExtra()
With CPUInf
If has_CPUID () = 1 Then
Select Case readVendorName()
Case "GenuineIntel": .sVendor = "Intel"
Case "UMC UMC UMC ": .sVendor = "UMC"
Case "AuthenticAMD": .sVendor = "AMD"
Case "CyrixInstead": .sVendor = "Cyrix"
Case "NexGenDriven": .sVendor = "NexGen"
Case "CentaurHauls": .sVendor = "Centaur"
Case "RiseRiseRise": .sVendor = "Rise Technology"
Case "SiS SiS SiS ": .sVendor = "SiS"
Case "GenuineTMx86": .sVendor = "Transmeta"
Case "Geode by NSC": .sVendor = "National Semiconductor"
End Select
If is_x64 () Then
.sArch = "AMD64"
Else
.sArch = GetArch()
EndIf
If is_AMD () Then
Dim As Byte _3dnow, _3dnowex, _mmxex, _sse4a, _sse5
Asm
mov eax,&h80000001
cpuid
test edx, &h400000
jz no_mmxex
mov Byte Ptr [_mmxex], 1
no_mmxex:
test edx, &h80000000
jz no_3dnow
mov Byte Ptr [_3dnow], 1
no_3dnow:
test edx, &h40000000
jz no_3dnowex
mov Byte Ptr [_3dnowex], 1
no_3dnowex:
Test ecx, &h40
jz no_sse4a
mov Byte Ptr [_sse4a], 1
no_sse4a:
Test ecx, &h800
jz no_sse5
mov Byte Ptr [_sse5], 1
no_sse5:
End Asm
.sh3DNow = *IIf(_3dnow, @"Yes", @"No")
.sh3DNowEx = *IIf(_3dnowex, @"Yes", @"No")
.shMMXEx = *IIf(_mmxex, @"Yes", @"No")
.shSSE4a = *IIf(_sse4a, @"Yes", @"No")
.shSSE5 = *IIf(_sse5, @"Yes", @"No")
.sNumCores = Str(_GetCoreCountAMD())
Else ' Intel
Dim As Byte _sse3, _ssse3, _sse41, _sse42, _vmx
Asm
mov eax, 1
cpuid
Test ecx, 1
jz no_sse3
mov Byte Ptr [_sse3], 1
no_sse3:
Test ecx, &h200
jz no_ssse3
mov Byte Ptr [_ssse3], 1
no_ssse3:
Test ecx, &h20
jz no_vmx
mov Byte Ptr [_vmx], 1
no_vmx:
Test ecx, &h80000
jz no_sse41
mov Byte Ptr [_sse41], 1
no_sse41:
Test ecx, &h100000
jz no_sse42
mov Byte Ptr [_sse42], 1
no_sse42:
End Asm
.shSSE3 = *IIf(_sse3, @"Yes", @"No")
.shSSSE3 = *IIf(_ssse3, @"Yes", @"No")
.shVMX = *IIf(_vmx, @"Yes", @"No")
.shSSE41 = *IIf(_sse41, @"Yes", @"No")
.shSSE42 = *IIf(_sse42, @"Yes", @"No")
.sNumCores = Str(_GetCoreCountIntel())
EndIf
.sBrand = readBrandString()
.sSpeed = "~" & Str(GetCPUClock()) & " Mhz"
.sFamily = Str(getFamily())
.sModel = Str(getModel())
.sStepping = Str(getStepping())
.shMMX = *IIf(has_MMX(), @"Yes", @"No")
.shSSE = *IIf(has_SSE(), @"Yes", @"No")
.shSSE2 = *IIf(has_SSE2(), @"Yes", @"No")
EndIf
End With
#Ifdef __FB_WIN32__
Dim hDC As HDC=GetDC(0)
Const BITSPIXEL = 12
Const PLANES = 14
With ResInf
.ubBPP=GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES)
Select Case .ubBPP
Case 1: .sBPP="monochrome"
Case 4: .sBPP="4 colors"
Case 8: .sBPP="256 colors"
Case Else: .sBPP=Str(.ubBPP) & " BPP"
End Select
.sRes=GetDeviceCaps(hDC, HORZRES) & "x" & GetDeviceCaps(hDC, VERTRES)
End With
ReleaseDC(0, hDC)
#EndIf
End Sub
Sub CollectInfo()
#Ifdef __FB_WIN32__
Dim p_MemInf As MEMORYSTATUSEX
p_MemInf.dwLength=Len(p_MemInf)
GlobalMemoryStatusEx(@p_MemInf)
With MemInf
.PhysTotal=ByteToMB(p_MemInf.ullTotalPhys)
.PhysAvail=ByteToMB(p_MemInf.ullAvailPhys)
.Phys_Used=.PhysTotal - .PhysAvail
.SwapTotal=ByteToMB(p_MemInf.ullTotalPageFile)
.SwapAvail=ByteToMB(p_MemInf.ullAvailPageFile)
.Swap_Used=.SwapTotal - .SwapAvail
End With
With AlgInf
.Sys=GetWindowsVersion()
'.Runtime = Format(((GetTickCount/1000)/60)/60, "h") & " hours"
.Runtime = Fix(((GetTickCount/1000)/60)/60) & " hours"
'.Runtime = Fix(((Timer)/60)/60) & " hours"
End With
#Else
Dim SI As sysinfo
sysinfo(SI)
With MemInf
.PhysTotal=ByteToMB(SI.totalram)
.PhysAvail=ByteToMB(SI.freeram)
.Phys_Used=.PhysTotal - .PhysAvail
.PhyShared=ByteToMB(SI.sharedram)
.PhyBuffer=ByteToMB(SI.bufferram)
.SwapTotal=ByteToMB(SI.totalswap)
.SwapAvail=ByteToMB(SI.freeswap)
.Swap_Used=.SwapTotal - .SwapAvail
End With
With AlgInf
.Sys="Linux"
If Timer < 120 Then
.Runtime = Format(SI.uptime, "s") & " sec."
Else
.Runtime = Format((SI.uptime/60)/60, "h") & " hours"
EndIf
End With
#EndIf
End Sub
Sub CreateHTMLReport ()
Dim As String _HRP
_HRP = *_HRPBegin
Dim As String HRP
HRP = _HRP
With MemInf
HRP = Replace(HRP, "[TOTALRAM]", Str(.PhysTotal) & " MB")
HRP = Replace(HRP, "[FREERAM]", Str(.PhysAvail) & " MB")
HRP = Replace(HRP, "[USEDRAM]", Str(.Phys_Used) & " MB")
HRP = Replace(HRP, "[SHAREDRAM]", Str(.PhyShared) & " MB")
HRP = Replace(HRP, "[BUFFEREDRAM]", Str(.PhyBuffer) & " MB")
HRP = Replace(HRP, "[TOTALSWAP]", Str(.SwapTotal) & " MB")
HRP = Replace(HRP, "[FREESWAP]", Str(.SwapAvail) & " MB")
HRP = Replace(HRP, "[USEDSWAP]", Str(.Swap_Used) & " MB")
End With
With CPUInf
HRP = Replace(HRP, "[CPU_BRAND]", .sBrand)
HRP = Replace(HRP, "[CPU_VENDOR]", .sVendor)
HRP = Replace(HRP, "[CPU_ARCH]", .sArch)
HRP = Replace(HRP, "[CPU_SPEED]", .sSpeed)
HRP = Replace(HRP, "[CPU_CORES]", .sNumCores)
HRP = Replace(HRP, "[CPU_FAMILY]", .sFamily)
HRP = Replace(HRP, "[CPU_MODEL]", .sModel)
HRP = Replace(HRP, "[CPU_STEPPING]", .sStepping)
HRP = Replace(HRP, "[HAS_3DNOW]", YesToSPR(.sh3DNow))
HRP = Replace(HRP, "[HAS_3DNOWEX]", YesToSPR(.sh3DNowEx))
HRP = Replace(HRP, "[HAS_MMX]", YesToSPR(.shMMX))
HRP = Replace(HRP, "[HAS_MMXEX]", YesToSPR(.shMMXEx))
HRP = Replace(HRP, "[HAS_SSE]", YesToSPR(.shSSE))
HRP = Replace(HRP, "[HAS_SSE2]", YesToSPR(.shSSE2))
HRP = Replace(HRP, "[HAS_SSE3]", YesToSPR(.shSSE3))
HRP = Replace(HRP, "[HAS_SSSE3]", YesToSPR(.shSSSE3))
HRP = Replace(HRP, "[HAS_SSE41]", YesToSPR(.shSSE41))
HRP = Replace(HRP, "[HAS_SSE42]", YesToSPR(.shSSE42))
HRP = Replace(HRP, "[HAS_SSE4a]", YesToSPR(.shSSE4a))
HRP = Replace(HRP, "[HAS_SSE5]", YesToSPR(.shSSE5))
HRP = Replace(HRP, "[HAS_VMX]", YesToSPR(.shVMX))
End With
HRP = Replace(HRP, "[OS_NAME]", AlgInf.Sys)
HRP = Replace(HRP, "[DISP_RES]", ResInf.sRes)
HRP = Replace(HRP, "[DISP_BPP]", ResInf.sBPP)
Dim As FILE Ptr rep
rep = fopen(StrPtr("fbSysMon.html"), StrPtr("w"))
'fwrite(@HRP, Len(HRP), 1, rep)
HRP = Left(HRP, Len(HRP)-5)
fputs(StrPtr(HRP), rep)
fclose(rep)
End Sub
Sub Rahmen(x As Integer, y As Integer, x2 As Integer, y2 As Integer)
Line(x,y)-(x2-2,y2-2), Grey150, B
Line(x+1,y+1)-(x2-1,y2-1), White, B
Line(x+2,y+2)-(x2,y2), Grey100, B
End Sub
Sub Header(x As Integer, y As Integer, t As String)
Line(x-1,y-1)-(x+(Len(t)*8),y+16), Black, BF
Draw String(x+1,y+1),t,Grey150
Draw String(x,y),t,White
End Sub
Sub Feld(x As Integer, y As Integer, r As Integer, t As String)
Draw String(x,y+16*r),t,Font_Color
End Sub
Sub Button(x As Integer, y As Integer, t As String)
Rahmen(x-4,y-4,x+4+Len(t)*8,y+18)
Draw String(x+1,y+1),t,Grey150
Draw String(x,y),t,White
End Sub
Sub DrawInfo()
Line(XVal,190)-(285,320), &h000000, BF
With MemInf
Feld(XVal,190, 0, Str(.PhysTotal) & " MB")
Feld(XVal,190, 1, Str(.PhysAvail) & " MB")
Feld(XVal,190, 2, Str(.Phys_Used) & " MB")
Feld(XVal,190, 3, Str(.PhyShared) & " MB")
Feld(XVal,190, 4, Str(.PhyBuffer) & " MB")
Feld(XVal,190, 5, Str(.SwapTotal) & " MB")
Feld(XVal,190, 6, Str(.SwapAvail) & " MB")
Feld(XVal,190, 7, Str(.Swap_Used) & " MB")
End With
Line(XVal,355)-(285,415), &h000000, BF
With AlgInf
Feld(XVal,355, 0, Cast(Integer, .CPU) & " %")
Feld(XVal,355, 1, .Sys)
Feld(XVal,355, 2, .Runtime)
End With
Line(XVal2,190)-(275+XDiff,260), &h000000, BF
With ResInf
Feld(XVal2,190, 0, .sBPP)
Feld(XVal2,190, 1, .sRes)
End With
Line(XVal2,295)-(590,415), &h000000, BF
With CPUInf
Feld(XVal2,300, 0, .sVendor)
Feld(XVal2,300, 1, .sArch)
Feld(XVal2,300, 2, .sSpeed)
Feld(XVal2,300, 3, .sNumCores)
Feld(XVal2,300, 4, .shMMX)
Feld(XVal2,300, 5, .shSSE)
Feld(XVal2,300, 6, .shSSE2)
End With
End Sub
Screen 18, 32, , &h08
For n As Integer = 0 To (48*4)-1 Step 4
Line(logo(n)+116, logo(n+1)+30)-(logo(n+2)+116, logo(n+3)+30), &hFFFFFF, BF
Next
Draw String(376, 122), "(c) 28398 Laboratories"
Draw String(376, 138), "http://28398.ath.cx/"
Line(0,0)-(637,477), Grey150, B
Line(1,1)-(638,478), White, B
Line(2,2)-(639,479), Grey100, B
Line(3,3)-(636,20), Title_Active, BF
Draw String(6,4), "fbSysMon", Title_Active_Font
Dim As Any Ptr CloseButton=ImageCreate(16,16, &h000000)
Line CloseButton, (0,0)-(15,15), White, B
Line CloseButton, (4,4)-(12,12), White
Line CloseButton, (4,12)-(12,4), White
Put(619, 4), CloseButton, PSet
ImageDestroy(CloseButton)
Rahmen(30,180,320,325)
Header(45,172,"Memory")
Feld(XField ,190, 0, "total RAM :")
Feld(XField ,190, 1, "free RAM :")
Feld(XField ,190, 2, "used RAM :")
Feld(XField ,190, 3, "shared RAM :")
Feld(XField ,190, 4, "buffered RAM :")
Feld(XField ,190, 5, "total swap :")
Feld(XField ,190, 6, "free swap :")
Feld(XField ,190, 7, "used swap :")
Rahmen(30,345,320,420)
Header(45,337,"Miscellaneous")
Feld(XField ,355, 0, "CPU load :")
Feld(XField ,355, 1, "OS :")
Feld(XField ,355, 2, "uptime :")
Rahmen(350,180,600,270)
Header(365,172,"Display")
Feld(XField2,190, 0, "Color depth :")
Feld(XField2,190, 1, "Resolution :")
Rahmen(350,290,600,420)
Header(364,282,"Processor")
Feld(XField2,300, 0, "Vendor :")
Feld(XField2,300, 1, "Architecture :")
Feld(XField2,300, 2, "Speed :")
Feld(XField2,300, 3, "Cores :")
Feld(XField2,300, 4, "Has MMX :")
Feld(XField2,300, 5, "Has SSE :")
Feld(XField2,300, 6, "Has SSE2 :")
Button(41,436,"Create HTML report")
Dim As Integer x, y, b
Dim As Double ftimer=Timer
CollectInfo()
CollectInfoExtra() ' things, which we must get only one time...
DrawInfo()
Do
Sleep 50
GetMouse(x, y, 0, b)
If (x>=619 And x<=635 And y>=4 And y<=20 And Bit(b, 0)) _
Or MultiKey(&h01) Then End
If (x>=37 And x<=189 And y>=432 And y<=454 And Bit(b, 0)) Then CreateHTMLReport()
If MultiKey(63) Then
Header(132,132,"updating...")
CollectInfo()
CollectInfoExtra()
DrawInfo()
Line(132,132)-(132+8*Len("updating..."), 132+16), Black, BF
EndIf
If ftimer + 2 < Timer Then
CollectInfo()
DrawInfo()
EndIf
Loop