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 程序启动窗体控制在桌面右下角

Delphi firedac 下的 sqlite [1] - 前言

Delphi 根据进程pid获取程序所在路径的函数

Delphi打开网址链接的四种方法

Delphi firedac 下的 sqlite [5] - 数据的插入、更新、删除

Delphi双击tmemo选择光标所在行

精通Delphi模拟按键

Delphi winapi: getmodulehandle - 获取一个模块(exe 或 dll)的句柄

Delphi调用createprocess创建进程

Delphi [android]获取屏幕的物理分辨率

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...