CPUUsage Multi-processeur

Programmation d'applications complexes
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

De retour, après quelques temps de recherche... Ce coup j'espère que c'est bon!!! :P

Le code utilise une librairie de microsoft nommé "Performance Data Helper" qui permet de récupérer tout plein d'infos dynamiques sur le système...

Donc la si ce code marche, on va pouvoir faire un vrai moniteur système :D

Le code...
; CPU Usage à partir de la librairie PDH (Performance Data Helper)
; Gillou

; Compteur
#PERF_TYPE_TEXT = $800
#PERF_TYPE_NUMBER = $0
#PERF_TEXT_ASCII = $10000
#PERF_TEXT_UNICODE = $0
#PERF_NUMBER_HEX = $0
#PERF_NUMBER_DECIMAL = $10000
#PERF_NUMBER_DEC_1000 = $20000
#PERF_DISPLAY_NO_SUFFIX = $0
#PERF_DISPLAY_NOSHOW = $40000000
#PERF_DISPLAY_PER_SEC = $10000000
#PERF_DISPLAY_PERCENT = $20000000
#PERF_DISPLAY_SECONDS = $30000000

; Format double
#PDH_FMT_DOUBLE = $200

; Type fenêtre de parcourt des compteurs
#BDC_IncludeInstanceIndex = $1
#BDC_SingleCounterPerAdd = $2
#BDC_SingleCounterPerDialog = $4
#BDC_LocalCountersOnly = $8
#BDC_WildCardInstances = $10
#BDC_HideDetailBox = $20
#BDC_InitializePath = $40
#BDC_DisableMachineSelection = $80
#BDC_IncludeCostlyObjects = $100
#BDC_ShowObjectBrowser = $200

; L'utilisateur a cliqué sur annulé
#PDH_DIALOG_CANCELLED = $800007D9

; Description d'un compteur
Structure Counter
    hCounter.l ;le Handle du compteur
    szCounterName.s ;le nom du compteur
EndStructure

; Contient une valeur de compteur
Structure PDH_FMT_COUNTERVALUE
    CStatus.l ; Renvoie le type
    padding.l
    ulValueLow.l
    ulValueHigh.l
EndStructure

; Paramétrage de la fenêtre de choix de compteur
Structure PDH_BROWSE_DLG_CONFIG
     ; DWORD bIncludeInstanceIndex :1;
     ; bSingleCounterPerAdd :1;
     ; bSingleCounterPerDialog :1;
     ; bLocalCountersOnly :1;
     ; bWildCardInstances :1;
     ; bHideDetailBox :1;
     ; bInitializePath :1;
     ; bDisableMachineSelection :1;
     ; bIncludeCostlyObjects :1;
     ; bShowObjectBrowser :1;
     ; bReserved :22;
    dwConfigFlags.l
    hwndOwner.l
    szDataSource.l
    szReturnPathBuffer.l
    cchReturnPathLength.l
    pCallBack.l
    dwCallBackArg.l
    CallBackStatus.l
    dwDefaultDetailLevel.l
    szDialogBoxCaption.l
EndStructure

; Liste des compteurs de la requête
Global NewList Counter.Counter()
; Handle de la requête
Global hQuery.l

Procedure.l cpu_count() ; Number of processors or cores
    Protected SI.SYSTEM_INFO
     GetSystemInfo_ (@SI)
     ProcedureReturn SI\dwNumberOfProcessors
EndProcedure

Procedure StrLen(lpString.l, Unicode.b= #False )
    Protected Lib
    Lib = OpenLibrary ( #PB_Any , "kernel32.dll" )
     If IsLibrary (Lib)
         If Unicode = #True
            Function = GetFunction (Lib, "lstrlenW" )
         Else
            Function = GetFunction (Lib, "lstrlenA" )
         EndIf
        Res = CallFunctionFast (Function, lpString)
         CloseLibrary (Lib)
     EndIf
     ProcedureReturn Res
EndProcedure

Procedure.s PdhConvertValue(*lpValue, dwType.l)
    
     CopyMemory (*lpValue, @lpValue.PDH_FMT_COUNTERVALUE, SizeOf (PDH_FMT_COUNTERVALUE))
    
     ; Si le type est TEXT
     If (dwType & $F00) = #PERF_TYPE_TEXT
         ; Si le type est UNICODE
         If (dwType & $F0000) = #PERF_TEXT_UNICODE
             ; On lit la chaine
            Res.s = PeekS (@lpValue\ulValueLow, StrLen(lpValue\ulValueLow, #True ), #PB_Unicode )
             ; Si le type est ASCII
         ElseIf (dwType & $F0000) = #PERF_TEXT_ASCII
             ; On lit la chaine
            Res.s = PeekS (@lpValue\ulValueLow, StrLen(lpValue\ulValueLow, #False ), #PB_Ascii )
         EndIf
         ; Si le type est numérique
     Else
        Value.d = PeekD (@lpValue\ulValueLow)
         ; En hexadécimal
         If (dwType & $F0000) = #PERF_NUMBER_HEX
             ; On convertit la valeur
            Res.s = HexQ (Value)
         Else
             ; Sinon on renvoie tel que
            Res.s = StrD (Value, 4)
         EndIf
     EndIf
    
     ; Si la valeur a besoin d'un suffixe
     If (dwType & $F0000000) = #PERF_DISPLAY_PER_SEC
        Res + "/sec"
     ElseIf (dwType & $F0000000) = #PERF_DISPLAY_PERCENT
        Res + "%"
     ElseIf (dwType & $F0000000) = #PERF_DISPLAY_SECONDS
        Res + "secs"
     EndIf
    
     ProcedureReturn Res
EndProcedure

Procedure PdhInit()
     PdhOpenQuery_ (0, 0, @hQuery)
     ClearList (Counter())
EndProcedure

Procedure PdhTerminate()
     PdhCloseQuery_ (hQuery)
EndProcedure
    
Procedure PDHAddCounter(CounterPath.s)
     If hQuery
         If PdhValidatePath_ (CounterPath) = #ERROR_SUCCESS
             AddElement (Counter())
            Counter()\szCounterName = CounterPath
             PdhAddCounter_ (hQuery, CounterPath, 0, @Counter()\hCounter)
             AddGadgetItem (1, ListIndex (Counter()), CounterPath)
         EndIf
     EndIf
EndProcedure

Procedure PDHRemoveCounter(CounterPath.s)
     If hQuery
         If PdhValidatePath_ (CounterPath) = #ERROR_SUCCESS
             ForEach Counter()
                 If Counter()\szCounterName = CounterPath
                     PDHRemoveCounter_ (Counter()\hCounter)
                     RemoveGadgetItem (1, ListIndex (Counter()))
                     DeleteElement (Counter())
                    Break
                 EndIf
             Next
         EndIf
     EndIf
EndProcedure

Procedure.s OpenCounterRequester(hwnd = 0, szCaption.s = "Ajouter un compteur..." )
    dlg.PDH_BROWSE_DLG_CONFIG ; paramètres de la boîte de dialogue
    
     ; inclure les instance + n'inclure que les compteurs locaux + pas de sélection de Machine + choix d'un seul compteur
    dlg\dwConfigFlags = #BDC_IncludeInstanceIndex | #BDC_LocalCountersOnly | #BDC_DisableMachineSelection | #BDC_SingleCounterPerDialog
     ; fenêtre parente
    dlg\hwndOwner = hwnd
    dlg\szDataSource = 0
     ; la chaîne du nom de compteur résultat
    CounterPath.s = Space (65536)
    dlg\szReturnPathBuffer = @CounterPath
     ; sa taille
    dlg\cchReturnPathLength = 65536
     ; pas de callback
    dlg\pCallBack = 0
    dlg\dwCallBackArg = 0
    dlg\CallBackStatus = #ERROR_SUCCESS
     ; niveau de détail
    dlg\dwDefaultDetailLevel = #PERF_DETAIL_EXPERT
     ; titre
    dlg\szDialogBoxCaption = @szCaption
    ret = PdhBrowseCounters_ (@dlg)
    
     ; si l'utilisateur n'a pas annulé
     If ret <> #PDH_DIALOG_CANCELLED
         ProcedureReturn CounterPath
     EndIf
EndProcedure
        
Procedure PdhRefresh()
     If hQuery And CountList (Counter()) > 0
         If PdhCollectQueryData_ (hQuery) = #ERROR_SUCCESS
             ForEach Counter()
                 If Counter()\hCounter <> 0
                     If PdhGetFormattedCounterValue_ (Counter()\hCounter, #PDH_FMT_DOUBLE , @dwType, @lpValue.PDH_FMT_COUNTERVALUE) = #ERROR_SUCCESS
                         SetGadgetItemText (1, ListIndex (Counter()), PdhConvertValue(@lpValue, dwType), 1)
                     EndIf
                 EndIf
             Next
         EndIf
     EndIf
EndProcedure
        
Win = OpenWindow ( #PB_Any , 0, 0, 430, 170, "CPU Usage Multi-Processors - PDH" , #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget )
If IsWindow (Win) And CreateGadgetList ( WindowID (Win))
     ListIconGadget (1, 10, 10, 420, 120, "Nom du compteur" , 295, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection )
     AddGadgetColumn (1, 1, "Valeur" , 100)
     ButtonGadget (2, 10, 140, 200, 20, "Ajouter un compteur" )
     ButtonGadget (3, 220, 140, 200, 20, "Supprimer le compteur" )
    
     ; On initialise la connexion pdh
    PdhInit()
     ; On ajoute nos compteurs
     For i = 0 To cpu_count()-1
        PDHAddCounter( "\Processeur(" + Str (i)+ ")\% temps Processeur" )
     Next
    PDHAddCounter( "\Processeur(_Total)\% temps Processeur" )
    
     ; On démarre la temporisation de rafraichissement automatique des valeurs
     SetTimer_ ( WindowID (Win), 1, 1000, @PdhRefresh())
    
     Repeat
         Select WaitWindowEvent ()
             Case #PB_Event_Gadget
                 Select EventGadget ()
                    
                     Case 2 ; Ajouter un compteur
                         ; On ouvre la boîte de dialogue des compteurs
                        CounterPath.s = OpenCounterRequester( WindowID (Win))
                         If Len (CounterPath) > 0
                            PDHAddCounter(CounterPath)
                         EndIf
                        
                     Case 3 ; Supprimerun compteur
                         If CountGadgetItems (1) > 0
                             For i=0 To CountGadgetItems (1)-1
                                 If GetGadgetItemState (1, i) & #PB_ListIcon_Selected = #PB_ListIcon_Selected
                                    PDHRemoveCounter( GetGadgetItemText (1, i, 0))
                                 EndIf
                             Next
                         EndIf
                 EndSelect
                
             Case #PB_Event_SizeWindow
                 ResizeGadget (1, #PB_Ignore , #PB_Ignore , WindowWidth (Win)-20, WindowHeight (Win)-50)
                 ResizeGadget (2, #PB_Ignore , WindowHeight (Win)-30, ( WindowWidth (Win)-30)/2, #PB_Ignore )
                 ResizeGadget (3, ( WindowWidth (Win)-30)/2+20, WindowHeight (Win)-30, ( WindowWidth (Win)-30)/2, #PB_Ignore )
                 SetGadgetItemAttribute (1, #PB_Ignore , #PB_ListIcon_ColumnWidth , GadgetWidth (1)-125, 0)
                
             Case #PB_Event_CloseWindow
                Quit = 1
         EndSelect
     Until Quit = 1
    
     KillTimer_ ( WindowID (Win), 1)
     ; On clos laconnexion Pdh
    PdhTerminate()
EndIf
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Vraiment du beau boulot Gillou :D
Ca fonctionne nickel avec mon double coeur. Tout ça avec une lib intégrée, c'est génial
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Répondre