PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

CPUUsage Multi-processeur

https://www.purebasic.fr/french/viewtopic.php?t=7683

Page 3 sur 3

Publié : lun. 21/janv./2008 19:59
par tmyke
Bon je viens de tester, et en fait je me retrouve dans le cas d'un des premiers de tes
linsting, c-à-d sur le %Usage je suis à 200 partout, y compris sur le total, par contre
cela varie a peu près de façon cohérente en fonction de la charges des processus.
Quand je lance une appli par exemple, le CPU TOTAL est à 225.

voilà..

Publié : lun. 21/janv./2008 22:34
par Gillou
Autre code complétement différent on repart de la base ;)

En utilisant WMI

@Tmyke
Cette solution mange vraiment le cpu et en plus ralenti considérablement l'appli, va falloir l'optimiser, mais serait super si déjà ça marche ;)
#COINIT_MULTITHREAD = 0
#RPC_C_AUTHN_LEVEL_CONNECT = 2
#RPC_C_IMP_LEVEL_IDENTIFY = 2
#EOAC_NONE = 0
#RPC_C_AUTHN_WINNT = 10
#RPC_C_AUTHZ_NONE = 0
#RPC_C_AUTHN_LEVEL_CALL = 3
#RPC_C_IMP_LEVEL_IMPERSONATE = 3
#CLSCTX_INPROC_SERVER = 1
#wbemFlagReturnImmediately = 16
#wbemFlagForwardOnly = 32
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly
#WBEM_INFINITE = $FFFFFFFF
#WMISeparator = ","

Procedure.l ansi2bstr(ansi.s)
    Size.l = MultiByteToWideChar_ ( #CP_ACP , 0, ansi, -1, 0, 0)
    Global Dim unicode.w(Size)
     MultiByteToWideChar_ ( #CP_ACP , 0, ansi, Len (ansi), unicode(), Size)
     ProcedureReturn SysAllocString_ ( @unicode())
EndProcedure

Procedure bstr2string (bstr)
    Shared WMIResult.s
    WMIResult.s = ""
    pos = bstr
     While PeekW (pos)
        WMIResult = WMIResult + Chr ( PeekW (pos))
        pos = pos + 2
     Wend
     ProcedureReturn @WMIResult
EndProcedure

Global loc.IWbemLocator, svc.IWbemServices, pUnk.IUnknown, pRefresher.IWbemRefresher, pConfig.IWbemConfigureRefresher
Global pEnumerator.IEnumWbemClassObject, pclsObj.IWbemClassObject, k.l
Global Dim wmitxt$(1)

Procedure OpenWMI()
    root.s = "root\cimv2"
    WMICommand.s = "select * from Win32_Processor,LoadPercentage"
     CoInitializeEx_ (0, #COINIT_MULTITHREAD )
    hres = CoInitializeSecurity_ (0, -1, 0, 0, #RPC_C_AUTHN_LEVEL_CONNECT , #RPC_C_IMP_LEVEL_IDENTIFY , 0, #EOAC_NONE , 0)
     If hres <> 0 : e$ = "unable to call CoInitializeSecurity" : Goto cleanup : EndIf
    hres = CoCreateInstance_ (?CLSID_WbemLocator, 0, #CLSCTX_INPROC_SERVER , ?IID_IWbemLocator, @loc.IWbemLocator)
     If hres <> 0 : e$ = "unable to call CoCreateInstance" : Goto cleanup : EndIf
    hres = loc\ConnectServer(ansi2bstr(root), 0, 0, 0, 0, 0, 0, @svc.IWbemServices)
     If hres <> 0 : e$ = "unable to call IWbemLocator::ConnectServer" : loc\Release() : Goto cleanup : EndIf
    hres = svc\QueryInterface(?IID_IUnknown, @pUnk.IUnknown)
    hres = CoSetProxyBlanket_ (svc, #RPC_C_AUTHN_WINNT , #RPC_C_AUTHZ_NONE , 0, #RPC_C_AUTHN_LEVEL_CALL , #RPC_C_IMP_LEVEL_IMPERSONATE , 0, #EOAC_NONE )
     If hres <> 0 : e$ = "unable to call CoSetProxyBlanket" : svc\Release() : loc\Release() : Goto cleanup : EndIf
    hres = CoSetProxyBlanket_ (pUnk, #RPC_C_AUTHN_WINNT , #RPC_C_AUTHZ_NONE , 0, #RPC_C_AUTHN_LEVEL_CALL , #RPC_C_IMP_LEVEL_IMPERSONATE , 0, #EOAC_NONE )
     If hres <> 0 : e$ = "unable to call CoSetProxyBlanket" : svc\Release() : loc\Release() : pUnk\Release() : Goto cleanup : EndIf
    pUnk\Release()
    
    hres= CoCreateInstance_ (?CLSID_WbemRefresher,0, #CLSCTX_INPROC_SERVER ,?IID_IWbemRefresher,@pRefresher.IWbemRefresher)
     If hres <> 0 : e$ = "unable to call CoCreateInstance" : svc\Release() : loc\Release() : Goto cleanup : EndIf
    hres=pRefresher\QueryInterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher)
     If hres <> 0 : e$ = "unable to QueryInterface" : svc\Release() : loc\Release() : pRefresher\Release() : Goto cleanup : EndIf
    pRefresher\refresh(0)
    
    k = CountString (WMICommand, #WMISeparator )
     Dim wmitxt$(k)
     For i = 0 To k
        wmitxt$(i) = StringField (WMICommand, i + 1, #WMISeparator )
     Next
    
EndProcedure

Procedure RefreshWMI()
    hres = svc\ExecQuery(ansi2bstr( "WQL" ), ansi2bstr(wmitxt$(0)), #IFlags , 0, @pEnumerator.IEnumWbemClassObject)
     If hres <> 0 : e$ = "unable to call IWbemServices::ExecQuery" : svc\Release() : loc\Release() : pRefresher\Release() : Goto cleanup : EndIf
    hres = pEnumerator\reset()
     Repeat
    hres = pEnumerator\ Next ( #WBEM_INFINITE , 1, @pclsObj.IWbemClassObject, @uReturn)
     If hres = 0
         For i = 1 To k
            Mem = AllocateMemory (1000)
            hres = pclsObj\get(ansi2bstr(wmitxt$(i)), 0, Mem, 0, 0)
            Type = PeekW (Mem)
             Select Type
                 Case 8
                    val$ = PeekS (bstr2string( PeekL (Mem + 8 )))
                 Case 3
                    val$ = Str ( PeekL (Mem + 8 ))
                 Default
                    val$ = ""
             EndSelect
             If uReturn <> 0 : If wmi$ : wmi$ = wmi$ + "|" + val$ : Else : wmi$ = val$ : EndIf : EndIf
             FreeMemory (Mem)
         Next
        pclsObj\Release()
     EndIf
Until uReturn = 0
n = CountString (wmi$, "|" )
If n > 0
    Total = 0
     For i=1 To n+1
        val = Val ( StringField (wmi$, i, "|" ))
        Total + val
         SetGadgetItemText (1, i-1, Str (val), 1)
     Next
     SetGadgetItemText (1, n+1, Str (Total/(n+1)), 1)
EndIf
EndProcedure

Procedure CloseWMI()
    svc\Release() : loc\Release() : pEnumerator\Release() : pRefresher\Release()
    cleanup :
     CoUninitialize_ ()
EndProcedure

Procedure.l cpu_count() ; Retourne le nombre de processeur
    Protected SI.SYSTEM_INFO
     GetSystemInfo_ (@SI)
     ProcedureReturn SI\dwNumberOfProcessors
EndProcedure

OpenWMI()

Win = OpenWindow ( #PB_Any , 0, 0, 200, 140, "CPU Usage Multi-Processors" , #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget )
If IsWindow (Win) And CreateGadgetList ( WindowID (Win))
     ListIconGadget (1, 10, 10, 180, 120, "CPU" , 75)
     AddGadgetColumn (1, 1, "% Usage" , 60)
    
    NumberOfProcessors = cpu_count()
    
     For i=0 To NumberOfProcessors-1
         AddGadgetItem (1, -1, "CPU " + Str (i))
     Next
     AddGadgetItem (1, NumberOfProcessors, "CPU TOTAL" )
    
     SetTimer_ ( WindowID (Win), 1, 1000, @RefreshWMI())
     Repeat
         Select WaitWindowEvent ()
             Case #PB_Event_Gadget
                 Select EventGadget ()
                     ;Case
                 EndSelect
             Case #PB_Event_CloseWindow
                Quit = 1
         EndSelect
     Until Quit = 1
     KillTimer_ ( WindowID (Win), 1)
    CloseWMI()
EndIf

End

DataSection
CLSID_IEnumWbemClassObject :
      ; 1B1CAD8C-2DAB-11D2-B604-00104B703EFD
Data.l $1B1CAD8C
Data.w $2DAB, $11D2
Data.b $B6, $04, $00, $10, $4B, $70, $3E, $FD
IID_IEnumWbemClassObject :
      ; 7C857801-7381-11CF-884D-00AA004B2E24
Data.l $7C857801
Data.w $7381, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
CLSID_WbemLocator :
      ; 4590f811-1d3a-11d0-891f-00aa004b2e24
Data.l $4590F811
Data.w $1D3A, $11D0
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24
IID_IWbemLocator :
      ; dc12a687-737f-11cf-884d-00aa004b2e24
Data.l $DC12A687
Data.w $737F, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
IID_IUnknown :
      ; 00000000-0000-0000-C000-000000000046
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IWbemRefresher:
      ;49353c99-516b-11d1-aea6-00c04fb68820
Data.l $49353C99
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
CLSID_WbemRefresher:
      ;c71566f2-561E-11D1-AD87-00C04FD8FDFF
Data.l $C71566F2
Data.w $561E, $11D1
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF
IID_IWbemConfigureRefresher:
      ;49353c92-516b-11d1-aea6-00c04fb68820
Data.l $49353C92
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
EndDataSection

Publié : mar. 22/janv./2008 18:49
par tmyke
Bon je viens de tester ton dernier code et... il en se passe rien. J'ai la liste des CPU, et aucunes
valeurs ne s'affiche... fenetre vierge, que ce soit sur une machine monoproc ou multi proc..

Publié : mer. 06/févr./2008 2:04
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

Publié : mer. 06/févr./2008 19:20
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
Fuseau horaire sur UTC+01:00
Page 3 sur 3

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru