Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

fbSysMon v.1.1

Uploader:Mitgliedcsde_rats
Datum/Zeit:04.12.2007 16:21:38

/'
    
    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"

#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 Red                 RGB(255, 0  , 0  )
#Define Green               RGB(0  , 255, 0  )
#Define Blue                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        Blue
#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 Integer
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
      OPEN ENVIRON("TEMP") + "\~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 " + ENVIRON("TEMP") + "\~CPULOAD.VBS"
      KILL ENVIRON("TEMP") + "\~CPULOAD.VBS"
      OPEN ENVIRON("TEMP") + "\~CPULOAD.TXT" FOR INPUT AS 1
      LINE INPUT #1, cpu
      CLOSE 1
      KILL ENVIRON("TEMP") + "\~CPULOAD.TXT"
      Return VAL(cpu)
    END Function
    #Macro 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="Microsoft Windows"
            .CPU=CPUAuslastung()
        End With
        ReleaseDC(0, hDC)
    #EndMacro
#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
          reserved2 as integer '8
          reserved3 as integer '12
          reserved4 as integer '16
          reserved5 as integer '20
          reserved6 as integer '24
    end type
    declare function info cdecl alias "sysinfo" (byref return as sysinfo) as integer
    #Macro 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"
        End With
    #EndMacro
#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
#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) RatsDevSoftware"

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 :")

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