Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
fbSysMon v.1.1.3
| Uploader: |  csde_rats |
| Datum/Zeit: | 20.06.2008 14:58:46 |
/'
fbSysMon
(c) 2007 RatsDevSoftware
http://ratsdevsoftware.ra.funpic.de/
'/
Dim As UInteger logo(0 TO 860) = {16777223,16842817,1086208,67526913,1074136321,283184400,68153614,822153489,290455569,420552983,1629098305,293674001,487719195,555684369,306259218,689037607,1630147121,310455314,_
756220203,556733201,323040531,957538615,1631195953,327236627,1024721211,557782033,339821844,1226039623,1632244785,344017940,1293222219,558830865,356603157,1494540631,1633293617,360799253,1561723227,559879697,373384470,_
1763041639,1634342449,377580566,1830224235,560928529,390165783,2031542647,1366955825,394333460,1981284731,561977281,406946072,2300064135,1368004705,411143448,2384003467,563026113,423727385,2568565143,1369053537,_
427924761,2652504475,564074945,440508698,2837066151,1370102369,400631066,2870641068,296557345,453096475,3038458295,1639455649,465680667,3239829947,29563857,468829212,3306955207,1640504481,482461980,3508330955,4054719697,_
488756508,3625791952,2446728609,498195485,3776831959,3521322497,502391837,3877536229,2447515297,514976798,4045332966,28251153,517076255,4146000374,3254329249,531755551,4162834942,570630145,535954720,119542278,3255378082,_
548537376,253706524,3524141186,560075552,354517522,3256099218,564270881,455201311,35725794,576856866,1948418594,2451906833,585245730,824361511,36512498,589443875,874742325,2989958050,602027555,1411629625,3527353009,_
608321571,1227125313,1380656226,612519204,1311044172,38937762,621957925,1428435449,3260294562,627201829,1579528799,3529516562,639788069,1764110949,2188060290,650271005,1780941414,309536370,656568103,1999061621,3262523298,_
668104999,1847247480,42149858,675445544,2133348998,2727028866,678595880,2401800846,569125154,694325544,2552836748,2727356786,700620073,2687079071,1117858226,693257258,2821345950,2729126450,706915626,2938802862,1118907170,_
724741163,3073012028,1387670274,736279339,3173778106,1119628306,740474668,3105735367,1388719234,750961452,3509379791,3536989362,761451308,3391935189,1926245762,766696493,3777880788,3538103810,770892845,3659428581,_
1927818786,783478062,4012794606,1123102498,791866415,4027646710,2734370690,796065071,3101438,1124020163,648216880,4281078506,3272290464,820186416,288424719,3809685795,826418224,422675223,587870627,833707568,556925727,_
3005428259,810753328,606319363,2989568675,845358130,1479738118,1127034914,828579891,406029109,2438410995,870530355,1093907252,4058919539,863181107,1110524741,1397371667,725813275,741671752,3276092691,892419636,624264023,_
3009098803,898762804,1597272847,1130182051,651372598,892740403,2741581331,338908466,943129452,862271203,923912759,1966539602,1130117027,708005398,808899447,3274586114,942888503,2066871175,2474981187,917731100,1714987874,_
3780917523,948086839,2537091873,865284467,971217426,2335818515,3787078179,924025400,2352554913,3818198867,375629092,2955015086,3820105635,976466977,2671317928,2736664995,983775803,2436592553,3279436481,932428854,_
826045350,2987146083,1005828156,3191591756,2479962867,1029951284,3273020353,1666791827,1015268668,2805769182,3815325171,1006884924,3577561399,334052659,1047782705,2685465582,594492626,1062414654,423572219,1945059218,_
325319741,3710985196,51200003,950271295,2419995610,1140528691,993261364,272323598,872758884,822346554,474047490,874201187,1082208577,1010602998,869024035,1086515010,490893816,2482913956,1085497409,338740269,4087431876,_
1112781121,540545446,1945648644,1137965635,742507571,3561177860,1147417139,339956467,2441560722,1108620867,289731599,1948992788,1145299268,1429386327,2485797892,1135891012,1246024112,3000321012,1179770436,2135270465,_
879445379,1183082802,692441861,294536818,1044667974,3662099191,1148077969,1187223109,1865979007,344147924,1161045063,1917276583,2999338548,1221711687,1011201155,3029551108,1226080825,2401834036,1686705780,783572808,_
2686186650,880560484,1248105511,2840212384,75840036,1164223008,4064892071,3805431987,1261675594,1397425228,3300477459,496245323,3140814013,1132873844,1234356548,3225224375,1385709588,1288861771,1447883193,3545517217,_
1249170232,1917674690,1153650003,507823423,3358975148,3839440836,1304736322,2286752484,1148472868,1274337870,3628598509,882659076,1166318106,3947676870,888356468,1318228534,944763494,3245232036,1327705423,121832709,_
4102115461,1048897358,3863970903,2224048612,1357170512,2387620964,2977321364,1356039248,172152093,1674727941,322246475,374207735,1150767413,1335170321,457917734,2234660709,1380262721,424895584,3040432676,1198858060,_
289682411,2230535397,309669942,3728991489,893338532,350571604,4128863560,3572781860,1279601485,1179522390,3847231541,1308938514,2941444532,3243463908,1359226965,3677746185,3308598659,1456826429,3528865088,2753712612,_
1396940117,1616217307,2775603061,1441893696,1162892625,1427068821,1384275287,1297601867,3041876117,1479877975,1934964061,1971673285,434464017,2371122582,361716021,422936341,2622039393,1704607733,1457856839,1465546091,_
2242401987,1123379544,1410409876,89265253,1532303963,1918518556,3777256309,1510053465,2572821584,90856373,1269154880,2086434217,4121778917,1544909910,2220564766,896949493,1461024860,3395114218,3513539797,1477810011,_
3646493816,2235193509,1550012764,3545953766,2780045237,1495635294,3982366052,93854965,343259485,3612517726,1979071381,767949397,4066199028,2248301413,1290134107,3142591996,1693212677,1624633440,3160425914,361455509,_
1592134468,371734031,2785565462,1607866455,439309844,3857454902,1628784991,3596264875,863855109,1388694369,375529766,1405379345,1642430562,3915544073,1964532565,1628839267,3378677299,3862649061,1574287707,795083242,_
3319423893,1682284890,912512478,4123944118,1687340900,1482856012,341992486,1708494949,761554215,3323289014,1700123233,1466118844,1445684550,627467599,1733932650,3060949014,1711697502,257570399,1684431990,1736782183,_
124073410,905275382,1720813160,1881503357,2252300518,1758813032,946259571,2973001542,1755440743,2238214798,904999062,1760949097,3847493132,2258783253,1585856820,946132428,370633125,1340149608,2956261023,2796249526,_
1797655110,90928675,2527619606,1714807653,57267728,918187030,1712626540,2188138058,372927637,1648634729,2535442125,3311886198,1515608939,3496416814,3602137302,939964754,1969836412,2461232582,1645653353,1718462108,_
2798022197,1788264020,3547068119,916876982,1855274602,3782108752,652101542,474410854,3897558738,3874516358,1351916911,3578611364,913009270,1857325680,3563894501,653749377,1879498308,225243762,3340005479,1707535719,_
2354939622,2798415670,1895198065,290531015,1729914087,1863778920,91415725,2804118279,1681323376,577644332,3072750087,1923437939,1634883289,1184788385,1920380787,1081366198,2269016823,1956051827,2859194116,1446933462,_
1530337132,2054522646,1196519382,1940342630,827131711,923694535,1972675957,1650063205,124022119,1960231030,1181910276,1955362439,1875334518,1467266852,393114871,2002053236,2154571631,2809619239,1965493093,4184811373,_
4151014838,1655103330,2187749245,927486775,2022111351,2541086465,1737648423,2030539125,2457442153,1737171207,2035768696,2071422592,2007595159,2057735802,2423969587,4142561782,2029494901,2590320505,931821479,1046983537,_
2222573328,3887624391,1778889061,3111888812,3350166551,2055716468,3463407542,3351673575,1949789546,3816630145,131692532,1957151331,3296515890,130579271,2110207869,2273204181,131366071,2121769335,695977965,3030351511,_
1738007165,2490075116,1470135447,2106060667,4269602806,119086743,2139561344,92202883,1738809144,2080614515,897116162,125332055,2118526590,1666430992,4159929015,2052549231,461490028,2819916168,2160301185,3007907859,_
940671094,1830294908,1350621214,908032199,2158481794,3145517021,3895951735,2163747700,3608332348,1742635063,2196258600,1165998021,3357638566,2222472051,1233041379,3360782696,2203556740,1451382829,1948156936,1822735710,_
3997082940,619021830,1323852678,1686530022,3092741800,1816681350,138508393,941175799,2245476995,1887827132,141701464,2275964806,2055684898,137463832,1756916866,310884479,4167594136,2216777092,3763619564,678070405,_
2278064771,3073665171,2290321719,2180539778,4253648673,408056308,1630039680,2034845847,947816840,2316872838,2943751479,3098642984,2312565890,2827597933,2562229880,2330188165,3112871078,2829945000,2266542731,2357995574,_
2553252824,2318977408,478390357,2562099448,2290663755,3629357247,2831649896,2311618444,2257385611,1487632328,2309177484,3541354699,1200442024,846785866,697231261,4176580280,2401823330,4086221047,1476956072,2409167755,_
4052699384,1224707944,2414412176,126812987,3103821993,2422797712,93391116,2279575769,2439582606,311490833,2836892649,2442730897,412128420,958370249,2419244946,697444644,2540999145,2460560259,4271040808,4179989107,_
2467902610,814377185,3107361705,2469648531,932448565,1759876041,2484683600,1200892221,2571048729,2492026260,2374347087,960926952,2506705557,1469383234,2572522905,2510832744,1637202260,692856761,2523488150,2759670108,_
157849176,775515542,1821829476,1231787641,2535012739,2039970164,963652617,2536077975,2022385522,4186150873,2546555287,2190993797,2825947625,2560200088,2387261839,1771214921,1273551661,2425960840,966498697,2571737722,_
2525256095,1234803209,2428083354,2795125127,1725667929,2599004556,2073758110,430676729,2377560475,3113920947,2197855113,2612639130,3030124990,431660073,2614280860,3365665219,1237949529,2632567452,3449582241,1238146345,_
2640956317,3902626255,970562833,2648299421,3701336536,2978061865,2657739165,3751709152,2581831337,2656173726,3953031661,703373081,4293994143}
Dim As Integer logo_byte = 164456
#Include "fbgfx.bi"
#Include "vbcompat.bi"
#Define RGBSame(x) RGB(x , x , x )
' Farben
#Define White RGB(255, 255, 255)
#Define Grey200 RGBSame(200 )
#Define Grey150 RGBSame(150 )
#Define Grey100 RGBSame(100 )
#Define Grey50 RGBSame(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
Type Mem
PhysTotal As Integer ' In MB!!!
PhysAvail As Integer
Phys_Used As Integer
PhyShared As Integer
PhyBuffer As Integer
SwapTotal As Integer
SwapAvail As Integer
Swap_Used As Integer
End Type
Type Res
ubBPP As UByte
sBPP As String
sByP As String
End Type
Type Alg
CPU As UByte
Sys As String
Arch As String
Runtime As String
End Type
Dim Shared MemInf As Mem
Dim Shared ResInf As Res
Dim Shared AlgInf As Alg
#Ifdef __FB_WIN32__
#Define WIN_INCLUDEALL
#Include "windows.bi"
#Define Pl "Windows"
Function CPUAuslastung() As UByte
Dim cpu As String
Dim pt As String
Dim x As String
x = Environ("TEMP")
If FileExists(StrPtr(x)) = vbTrue Then
pt=x
Else
x = Environ("TMP")
If FileExists(StrPtr(x)) = vbTrue Then
pt=x
Else
pt="C:"
EndIf
EndIf
Open pt & "\cpuload.vbs" For Output As #1
Print #1, "Option Explicit"
Print #1, ""
Print #1, "Dim oWMI, aCPU, oCPU, oFS, oTs"
Print #1, "Set oWMI = GetObject(" + CHR(34) + "winmgmts://." + CHR(34) + ")"
Print #1, "Set oFS = CreateObject(" + CHR(34) + "Scripting.FileSystemObject" + CHR(34) + ")"
Print #1, "Set oTs = oFS.CreateTextFile(" + CHR(34) + ENVIRON("TEMP") + "\CPULOAD.TXT" + CHR(34) + ",True)"
Print #1, "Set aCPU = oWMI.InstancesOf(" + CHR(34) + "Win32_Processor" + CHR(34) + ")"
Print #1, "For Each oCPU In aCPU"
Print #1, " oTs.WriteLine CStr(oCPU.LoadPercentage)"
Print #1, "Next"
Print #1, "oTs.Close"
Print #1, "Set oTs = Nothing"
Print #1, "Set aCPU = Nothing"
Print #1, "Set oWMI = Nothing"
Print #1, "Set oFS = Nothing"
Close #1
Shell "cscript //NoLogo " & pt & "\CPULOAD.VBS"
Open pt & "\CPULOAD.TXT" For Input As #1
Line Input #1, cpu
Close #1
Kill pt & "\~CPULOAD.VBS"
Kill pt & "\~CPULOAD.TXT"
Return VAL(cpu)
End Function
Sub CollectInfo()
Dim p_MemInf As MEMORYSTATUS
p_MemInf.dwLength=Len(p_MemInf)
GlobalMemoryStatus(@p_MemInf)
With MemInf
.PhysTotal=ByteToMB(p_MemInf.dwTotalPhys)
.PhysAvail=ByteToMB(p_MemInf.dwAvailPhys)
.Phys_Used=.PhysTotal - .PhysAvail
.SwapTotal=ByteToMB(p_MemInf.dwTotalPageFile)
.SwapAvail=ByteToMB(p_MemInf.dwAvailPageFile)
.Swap_Used=.SwapTotal - .SwapAvail
End With
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="Monochrom (Schwarz/Weiss)"
CAse 4
.sBPP="4 Farben"
CAse 8
.sBPP="256 Farben"
.sByP="1 Byte per Pixel"
CAse 15
.sBPP="15 Bit Farbtiefe"
.sByP="2 Bytes per Pixel"
CAse 16
.sBPP="16 Bit Farbtiefe"
.sByP="2 Bytes per Pixel"
CAse 24
.sBPP="24 Bit Farbtiefe"
.sByP="3 Bytes per Pixel"
CAse 32
.sBPP="32 Bit Farbtiefe"
.sByP="4 Bytes per Pixel"
End Select
End With
With AlgInf
.Sys="Windows"
.CPU=CPUAuslAstung()
End With
ReleAseDC(0, hDC)
End Sub
#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 info Cdecl Alias "sysinfo" (ByRef return As sysinfo) As Integer
Sub CollectInfo()
Dim SI As sysinfo
info(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 SI.uptime > 60 Then
.Runtime=Str(CAst(Integer, SI.uptime/60)) & " Minuten"
ElseIf SI.uptime > 60*60 Then
.Runtime=Str(CAst(Single, (SI.uptime/60)/60)) & " Stunden"
EndIf
End With
End Sub
#EndIf
#Macro Rahmen(x,y,x2,y2)
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
#EndMacro
#Macro Header(x,y,t)
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
#EndMacro
#Macro Feld(x,y,r,t)
Draw String(x,y+16*r),t,Font_Color
#EndMacro
#Macro DrawInfo()
Line(155,190)-(285,320), &h000000, BF
With MemInf
Feld(179,190, 0, Str(.PhysTotal) & " MB")
Feld(179,190, 1, Str(.PhysAvail) & " MB")
Feld(179,190, 2, Str(.Phys_Used) & " MB")
Feld(179,190, 3, Str(.PhyShared) & " MB")
Feld(179,190, 4, Str(.PhyBuffer) & " MB")
Feld(179,190, 5, Str(.SwapTotal) & " MB")
Feld(179,190, 6, Str(.SwapAvail) & " MB")
Feld(179,190, 7, Str(.Swap_Used) & " MB")
End With
Line(155,355)-(285,415), &h000000, BF
With AlgInf
Feld(179,355, 0, .Sys)
Feld(179,355, 1, .Arch)
Feld(179,355, 2, .Runtime)
End With
#EndMacro
#Macro MakeInfo()
Header(132,132,"Aktualisiere...")
CollectInfo()
DrawInfo()
Line(132,132)-(132+8*Len("Aktualisiere..."), 132+16), Black, BF
#EndMacro
Using FB
Screen 18, 32, 1, GFX_NO_FRAME
Declare Function Decode Alias "fb_hDecode" ( _
ByVal lpIn As Any Ptr, _
ByVal asize As Integer, _
ByVal lpOut As Any Ptr, _
ByRef out_size As Integer _
) As INTEGER
'Image entpacken, in ein Bytearray einlesen
ReDim Buffer2 (logo_byte) As UByte 'einfaches Array für dAs Image
Decode (@logo(0), UBound(logo)*4, @Buffer2(0), logo_byte) 'entpacken
Put (116, 30), @Buffer2(0), PSet 'anzeigen
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,290,325)
Header(45,172,"Speicher")
Rahmen(340,180,600,270)
Header(355,172,"Anzeige")
Rahmen(30,345,290,420)
Header(45,337,"Sonstiges")
Feld(35,190, 0, "Totaler RAM :")
Feld(35,190, 1, "Freier RAM :")
Feld(35,190, 2, "Belegter RAM :")
Feld(35,190, 3, "Shared RAM :")
Feld(35,190, 4, "Buffered RAM :")
Feld(35,190, 5, "Totaler Swap :")
Feld(35,190, 6, "Freier Swap :")
Feld(35,190, 7, "Belegter Swap :")
Feld(35,355, 0, "Betriebssystem:")
Feld(35,355, 1, "CPU Arch. :")
Feld(35,355, 2, "Uptime :")
Dim As Integer x, y, b
MakeInfo()
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(SC_ESCAPE) Then End
If MultiKey(SC_F5) Then
MakeInfo()
EndIf
Loop