Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
56 - TAUX D'OCCUPATION DU PROCESSEUR

PRÉSENTATION : Affichage de l'occupation du processeur
ZIP : Téléchargez le zip APERÇUS : -1.jpg-

NOTES : Ce source ne fonctionne qu'avec Windows 2000 serveur et Windows Xp.

Ceci ne tient pas compte non plus d'un système multi-processeurs

CODE :
Unit Unit1;
//
// Sujet : Taux d'occupation du processeur
//
// Par Nono40 : http://nono40.developpez.com   http://nono40.fr.st
//              mailTo:nono40@fr.st
//
// Le 02/05/2003
// Attention : compatible seulement avec Windows2000 serveur et Windows XP
//

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

Type
  TForm1 = Class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    Button2: TButton;
    Button3: TButton;
    Label4: TLabel;
    Label5: TLabel;
    ProgressBar1: TProgressBar;
    Label2: TLabel;
    Label3: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Procedure Button2Click(Sender: TObject);
    Procedure Button3Click(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
  Private
    { Déclarations privées }
  Public
    { Déclarations publiques }
  End;

Var
  Form1: TForm1;

Implementation

{$R *.dfm}

Type
  // Structure utilisée pour le retour des temps d'utilisation systèmes
  TSYSTEM_PROCESSOR_PERFORMANCE_INFORMATION=Record
    Case Integer Of
    1:( IdleTime   : Int64;   // Temps inoccupé    par pas de 100 NanoSecondes
        KernelTime : Int64;   // Temps du noyau    par pas de 100 NanoSecondes
        UserTime   : Int64;   // Temps utilisateur par pas de 100 NanoSecondes
        Reserved1  : Array[0..2]Of Int64;
        Reserved2  : Cardinal;);
    2:( Res        : Array[1..$138]Of Byte);
  End;

// Fonction de demande d'informations sytèmes. Elle sert pour diverses
// demandes sytèmes suivant le paramètre SystemInfoClass. Voir MSDN
// pour plus de détails.
Function NtQuerySystemInformation(SystemInfoClass:Integer;Info:Pointer;InfoLength:Cardinal;
            Var ReturnLength:Cardinal):Integer;StdCall;
            External 'NTDLL.DLL' Name 'NtQuerySystemInformation';

Const
  // Constante utilisée pour la demande d'occupation du processeur
  SystemProcessorPerformanceInformation=$2;

  // Constantes de conversion
  CentNanoSecondesParJour = 24.0*60.0*60.0*10000000.0;
  MilliSecondesParJour    = 24.0*60.0*60.0*1000.0;

Var
  MemTickTotal : Integer = 0;
  MemTickIdle  : Integer = 0;

Procedure TForm1.Timer1Timer(Sender: TObject);
Var Info      : TSYSTEM_PROCESSOR_PERFORMANCE_INFORMATION;
    Long      : Cardinal;
    TickTotal : Integer;
    TickIdle  : Integer;
    DiffTotal : Integer;
    DiffIdle  : Integer;
    Occupe    : Double;
Begin
  // Primo on demande les information au système
  NtQuerySystemInformation(SystemProcessorPerformanceInformation,@Info,SizeOf(Info),Long);

  // Conversion du temps 'idle' en millisecondes
  TickIdle  := Info.IdleTime Div 10000;
  // Obtention du temps total
  TickTotal := GetTickCount;

  // Calcul du pourcentage
  DiffIdle  := TickIdle  - MemTickIdle;
  DiffTotal := TickTotal - MemTickTotal;
  Occupe    := 100-DiffIdle/DiffTotal*100;
  If Occupe<0 Then Occupe:=0;

  // Affichage des informations
  Label1.Caption        := FormatDateTime('HH:NN:SS:zzz',Info.IdleTime   /CentNanoSecondesParJour);
  Label4.Caption        := FormatDateTime('HH:NN:SS:zzz',TickTotal       /MilliSecondesParJour   );
  Label5.Caption        := IntToStr(Round(Occupe));
  ProgressBar1.Position := Trunc(Occupe);

  // Mémorisation pour le prochain passage
  MemTickIdle  := TickIdle;
  MemTickTotal := TickTotal;
End;


Var Fin:Boolean;
Procedure TForm1.Button2Click(Sender: TObject);
Begin
  Fin:=False;
  Button2.Enabled:=False;
  While Not Fin Do Application.ProcessMessages;
  Button2.Enabled:=True;
End;

Procedure TForm1.Button3Click(Sender: TObject);
Begin
  Fin := True;
End;

end.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -