delphi 获取cpu占用时间-木庄网络博客

本文整理自网络，侵删。
 {
  uCpuUsage unit demo application.
  (c) Janis Elsts, http://w-shadow.com/
  
  Requires madKernel library ( http://www.madshi.net/ ).
  Displays a list of processes along with their CPU usage.
}

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, madKernel, uCpuUsage, XPMan;

type
  TfmMain = class(TForm)
    lvProc: TListView;
    Timer1: TTimer;
    XPManifest1: TXPManifest;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lvProcColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvProcCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);//}
  private
    { Private declarations }
    Procedure UpdateView;
  public
    { Public declarations }
  end;

var
  fmMain: TfmMain;
  mProcesses:IProcesses;

implementation

{$R *.dfm}

Procedure TfmMain.UpdateView;
var
 i,j:integer;
 aItem:TListItem;
 found:boolean;
 p:PCPUUsageData;
 s:string;
begin
 //Update the process list
 mProcesses.RefreshItems;

 for i:=0 to mProcesses.ItemCount-1 do begin
   //Attempt to find the process in the list of already running processes
   found:=false; aItem:=nil;
   for j:=0 to lvProc.Items.Count-1 do
    if PCPUUsageData(lvProc.Items[j].Data).PID=
       mProcesses.Items[i].ID then begin
     aItem:=lvProc.Items[j];
     PCPUUsageData(aItem.Data).Tag:=1;
     found:=true;
     break;
    end;
   if not found then begin
    p:=wsCreateUsageCounter(mProcesses.Items[i].ID);
    if p<>nil then begin //skip system processes etc.
      aItem:=lvProc.Items.Add;
      p.Tag:=1;
      aItem.Data:=p;
      aItem.SubItems.Add(ExtractFileName(mProcesses.Items[i].ExeFile));
      aItem.SubItems.Add('N/A');
      aItem.Caption:=inttostr(p.PID);
    end;
   end;
   if (aItem<>nil) then begin
    s:=FormatFloat('00',round(wsGetCpuUsage(aItem.data)));
    if s<>aItem.SubItems.Strings[1] then
      aItem.SubItems.Strings[1]:=s;
   end;
 end;

 i:=0;
 while i<lvProc.Items.Count do begin
  if PCPUUsageData(lvProc.Items[i].Data).Tag=0 then begin
   wsDestroyUsageCounter(PCPUUsageData(lvProc.Items[i].Data));
   lvProc.Items.Delete(i);
  end else begin
   PCPUUsageData(lvProc.Items[i].Data).Tag:=0;
   inc(i);
  end;
 end;//}

 if abs(lvProc.tag)=3 then lvProc.AlphaSort;
end;

procedure TfmMain.Timer1Timer(Sender: TObject);
begin
 UpdateView;
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
 mProcesses:=Processes;
 UpdateView;
 Timer1.Enabled:=true;
end;

procedure TfmMain.lvProcColumnClick(Sender: TObject; Column: TListColumn);
begin
 if lvProc.Tag=Column.Index+1 then lvProc.Tag:=-Column.Index-1
  else lvProc.Tag:=Column.Index+1;
 lvProc.AlphaSort;
end;

procedure TfmMain.lvProcCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
 p1,p2:PCPUUsageData;
 i,dir:integer;
 s1,s2:string;
begin
 p1:=Item1.Data; p2:=Item2.Data;
 i:=lvProc.Tag;
 if i<0 then begin
  dir:=-1; i:=-i;
 end else dir:=1;
 //Choose the apropriate sort order
 case i of
 1 :begin
  //sort by PID
  if p1.PID<p2.PID then Compare:=-1
   else if p1.PID>p2.PID then Compare:=1
    else Compare:=0;
  end;
 2 : begin
  //sort by filename
   if item1.SubItems.Count<1 then Compare:=0 else begin
    s1:=LowerCase(ExtractFileName(item1.SubItems.Strings[0]));
    s2:=LowerCase(ExtractFileName(item2.SubItems.Strings[0]));
    if s1<s2 then Compare:=-1
     else if s1>s2 then Compare:=1
      else Compare:=0;
   end;
  end;
 3 : begin
  //sort by CPU usage
  if p1.LastUsage<p2.LastUsage then Compare:=-1
   else if p1.LastUsage>p2.LastUsage then Compare:=1
    else Compare:=0;
  end;
 end;
 Compare:=Compare*dir;
end;//}

end.






{
(c) Janis Elsts, http://w-shadow.com/
Last Updated : 27.08.2006

uCpuUsage.pas provides some functions that let you
get the CPU usage (in percent) of a given process. Note that
the usage is calculated for a *period of time* elapsed since
last wsCreateUsageCounter or wsGetCpuUsage call for that process.
This unit is freeware, feel free to use/modify in any way you like.

Using this unit :

  cnt : PCPUUsageData;
  ....
  //Initialize the counter
  cnt:=wsCreateUsageCounter(Process_id);
  //Allow for some time to elapse
  Sleep(500);
  //Get the CPU usage
  usage:=wsGetCpuUsage(cnt);
  //The returned value is a real number between 0 and 100 (representint %).
  //Destroy the counter and free memory
  wsDestroyUsageCounter(cnt);
}

unit uCpuUsage;

interface

const
 wsMinMeasurementInterval=250; {minimum amount of time that must
 have elapsed to calculate CPU usage, miliseconds. If time elapsed
 is less than this, previous result is returned, or zero, if there
 is no previous result.}
 
type
  TCPUUsageData=record
    PID,Handle:cardinal;
    oldUser,oldKernel:Int64;
    LastUpdateTime:cardinal;
    LastUsage:single; //Last result of wsGetCpuUsage is saved here
    Tag:cardinal; //Use it for anythin you like, not modified by this unit
  end;
  PCPUUsageData=^TCPUUsageData;

function wsCreateUsageCounter(PID:cardinal):PCPUUsageData;
function wsGetCpuUsage(aCounter:PCPUUsageData):single;
procedure wsDestroyUsageCounter(aCounter:PCPUUsageData);

implementation

uses Windows;

function wsCreateUsageCounter(PID:cardinal):PCPUUsageData;
var
 p:PCPUUsageData;
 mCreationTime,mExitTime,mKernelTime,
 mUserTime:_FILETIME;
 h:cardinal;
begin
 result:=nil;
 //We need a handle with PROCESS_QUERY_INFORMATION privileges
 h:=OpenProcess(PROCESS_QUERY_INFORMATION,false,PID);
 if h=0 then exit;
 new(p);
 p.PID:=PID;
 p.Handle:=h;
 p.LastUpdateTime:=GetTickCount;
 p.LastUsage:=0;
 if GetProcessTimes(p.Handle,mCreationTime,mExitTime,mKernelTime,
                 mUserTime) then begin
  //convert _FILETIME to Int64               
  p.oldKernel:=int64(mKernelTime.dwLowDateTime or
          (mKernelTime.dwHighDateTime shr 32));
  p.oldUser:=int64(mUserTime.dwLowDateTime or
          (mUserTime.dwHighDateTime shr 32));
  Result:=p;
 end else begin
  dispose(p);
 end;
end;

procedure wsDestroyUsageCounter(aCounter:PCPUUsageData);
begin
 CloseHandle(aCounter.Handle);
 dispose(aCounter);
end;

function wsGetCpuUsage(aCounter:PCPUUsageData):single;
var
 mCreationTime,mExitTime,mKernelTime,
 mUserTime:_FILETIME;
 DeltaMs,ThisTime:cardinal;
 mKernel,mUser,mDelta:int64;
begin
 result:=aCounter.LastUsage;

 ThisTime:=GetTickCount;
 //Get the time elapsed since last query
 DeltaMs:=ThisTime-aCounter.LastUpdateTime;
 if DeltaMs<wsMinMeasurementInterval then exit;
 aCounter.LastUpdateTime:=ThisTime;

 GetProcessTimes(aCounter.Handle,mCreationTime,mExitTime,mKernelTime,
                 mUserTime);

 //convert _FILETIME to Int64
 mKernel:=int64(mKernelTime.dwLowDateTime or
          (mKernelTime.dwHighDateTime shr 32));
 mUser:=int64(mUserTime.dwLowDateTime or
          (mUserTime.dwHighDateTime shr 32));

 //get the delta
 mDelta:=mUser+mKernel-aCounter.oldUser-aCounter.oldKernel;
 aCounter.oldUser:=mUser;
 aCounter.oldKernel:=mKernel;
 Assert(DeltaMs>0);
 Result:=(mDelta/DeltaMs)/100; //mDelta is in units of 100 nanoseconds, so...
 aCounter.LastUsage:=Result; //just in case you want to use it later, too
end;

end.
delphi 获取cpu占用时间

相关推荐

评论
