PureBasic

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

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