Fréquence d'un processeur multicore

[Le Soldat Inconnu]

Salut,

Un petit code pour récupérer la fréquence de votre processeur.

J'ai repris un vieux code qui ne marchait plus car compatible uniquement pour un processeur monocore ce qui devient de plus en plus rare.
J'ai donc corrigé pour le rendre fonctionnel en multicore.

Code : Tout sélectionner

Procedure.l GetProcessorFrequency() ; Retourne la fréquence du processeur
  Protected Resultat, Lib
  Structure PROCESSOR_POWER_INFORMATION
    Number.l ; Numéro du processeur
    MaxMhz.l ; Fréquence max en mhz de la configuration actuelle
    CurrentMhz.l ; Fréquence actuelle
    MhzLimit.l ; Fréquence max en mhz supportée par le processeur
    MaxIdleState.l
    CurrentIdleState.l
  EndStructure
  Lib = OpenLibrary(#PB_Any, "PowrProf.dll")
  If Lib
		GetSystemInfo_(SystemInfo.SYSTEM_INFO)
		Dim lpOutputBuffer.PROCESSOR_POWER_INFORMATION(SystemInfo\dwNumberOfProcessors - 1)
    If CallFunction(Lib, "CallNtPowerInformation", 11, 0, 0, lpOutputBuffer(), SizeOf(PROCESSOR_POWER_INFORMATION) * SystemInfo\dwNumberOfProcessors) = 0
      Resultat = lpOutputBuffer(0)\MaxMhz
			CompilerIf #PB_Compiler_Debugger
				For i = 0 To SystemInfo\dwNumberOfProcessors - 1
					Debug "Processeur " + Str(lpOutputBuffer(i)\Number)
					Debug "Fréquence maximum : " + Str(lpOutputBuffer(i)\MaxMhz)
					Debug "Fréquence actuelle : " + Str(lpOutputBuffer(i)\CurrentMhz)
					Debug "Fréquence limite supportée : " + Str(lpOutputBuffer(i)\MhzLimit)
					Debug ""
				Next
			CompilerEndIf
    EndIf
    CloseLibrary(Lib)
  EndIf
  ProcedureReturn Resultat
EndProcedure

MessageRequester("Information", "Fréquence du processeur :" + Chr(10) + Str(GetProcessorFrequency()) + " Mhz")

Je cherche à faire une fonction pour récupéré le taux d'utilisation du processeur mais je n'ai pas encore trouvé. Si l'un d'entre vous a ceci en stock, je suis preneur. Merci

[Kwai chang caine]

Merci du partage Soldat

J'ai repris un vieux code qui ne marchait plus car compatible uniquement pour un processeur monocore ce qui devient de plus en plus rare.

Ah bon...j'viens juste de me mettre au P4

Moi j'ai ce code de HELLE dans ma hotte....j'sais pas si ça peut te servir, car comme dab...en temps que LAMER professionnel, j'comprend pas tout ce que je copie

Code : Tout sélectionner

;- CPU-Auslastung-Ermittlung mit der PDH.DLL, auch für Multi-Core-CPU´s 
;- W2k, WXP, Vista(?) 
;- "Helle" Klaus Helbing, 22.03.2008, PB4.10 
;- Soll nur schmucklos die einfache Machbarkeit zeigen! 

Global hQuery.l 
Global RetVal.l 
Global Core.l 

Global SI.SYSTEM_INFO 

;#PDH_CSTATUS_VALID_DATA = $0 
#PDH_CSTATUS_NEW_DATA = $1 

;ich mag keine Structuren... 
Core = AllocateMemory(64)              ;für max. 4 Cores, 0-15=Counter, 16-31=PdhStatus, 32-63=dblValue 

Prototype.d ProtoValue(Para1.l, Para2.l)    ;CallFunction geht nicht wegen Double-Rückgabewert! 

Procedure.l cpu_count()                ;Anzahl der Cores ermittlen 
  GetSystemInfo_(@SI) 
  ProcedureReturn SI\dwNumberOfProcessors 
EndProcedure 

If OpenLibrary(0, "PDH.DLL")           ;MS-File in \System32 
  RetVal = CallFunction(0, "PdhOpenQuery", 0, 1, @hQuery) 
  If RetVal 
    MessageRequester("Fehler !", "Aufruf von PdhOpenQuery fehlgeschlagen!")  
  EndIf 
  
  cpu_count() 
  
  For i=0 To SI\dwNumberOfProcessors - 1 
    Temp$ = "\Prozessor("+ Str(i) +")\Prozessorzeit (%)" ; <=== Ligne rajoutée par KCC, pour compatibilité de l'appel callfunction, alors be careful :-))
    RetVal = CallFunction(0, "PdhVbAddCounter", hQuery, @Temp$, Core+4*i)   ;Counter ; <=== Ligne modifié par KCC, pour compatibilité de l'appel callfunction, alors be careful :-))
    If RetVal 
      MessageRequester("Fehler !", "Aufruf von PdhVbAddCounter für Core"+ Str(i) +" fehlgeschlagen!")  
    EndIf 
  Next 
  
  Repeat 
    CallFunction(0, "PdhCollectQueryData", hQuery) 
    Auslastung$="" 
    For i=0 To SI\dwNumberOfProcessors - 1 
      Value.ProtoValue = GetFunction(0, "PdhVbGetDoubleCounterValue") 
      A.l=i<<3 
      B.d=Core+32+A                    ;dblValue 
      B = Value(PeekL(Core+4*i), Core+16+i<<2) 
      Auslastung$ + "Auslastung Core" + Str(i)+" = "+ StrD(B, 2) + "%" + Space(20) 
      If PeekL(Core+16+i<<2) > #PDH_CSTATUS_NEW_DATA  ;s.o. 
        A = -1                         ;war kein gültiger Wert 
        Break 
      EndIf      
    Next 

    If A <> -1 
      Debug Auslastung$ 
    EndIf 
    Delay(500) 
  ForEver 

  CallFunction(0, "PdhCloseQuery", hQuery) 
  CloseLibrary(0) 
EndIf 

[falsam]

@Le Soldat Inconnu : Joli ce code On en veut encore du même genre.

[Le Soldat Inconnu]

KCC : Ton code ne fonctionne pas chez moi ... Et ça a l'air d'un beau souk, d'aller chercher des compteurs de performance

[Kwai chang caine]

Ouai !!! comme j't'ai dit...j'y connais pas grand chose dans ce domaine.
En plus j'ai pas de PC multicoeur, ça marque 0% tout le temps, j'ai cru que cetait pour ça

Comme ça avait l'air de parler de ce que tu demandait, j'me suis dit que ça aurait pu au moins t'indiquer une voie
Bon bin apparement c'est loupé

[venom]

Merci Soldat ,
très utile bravo





@++