高手，您好: 我要如何取得某一PORCESS的CPU佔用使用率? 拜託了。先謝謝了。 DHM

------
ATEIN

參考這篇看看: 
http://groups.google.com.tw/groups?q=process + cpu + usage + GetProcessTimes + delphi&hl=zh-TW&lr=&rls=GGLD,GGLD:2005-04,GGLD:zh-TW&selm=41ed0bc9$1@newsgroups.borland.com&rnum=4

<textarea class="delphi" rows="10" cols="60" name="code"> function GetProcessCPU: TDateTime; var CreationTime, ExitTime, KernelTime, UserTime: TFileTime; begin GetProcessTimes(GetCurrentProcess, CreationTime, ExitTime, KernelTime, UserTime); Result := AddFileTimes(KernelTime, UserTime); end; function AddFileTimes(Time1, Time2: TFileTime): TDateTime; var SysTime1, SysTime2: TSystemTime; begin FileTimeToSystemTime(Time1, SysTime1); FileTimeToSystemTime(Time2, SysTime2); Result := SystemTimeToDateTime(SysTime1) SystemTimeToDateTime(SysTime2); end; </textarea>
發表人 - hagar 於 2005/02/17 18:26:15

引言: 高手，您好: 我要如何取得某一PORCESS的CPU佔用使用率? 拜託了。先謝謝了。 DHM

高手版主，您好:我有試了,但只能最得日期，cpu 佔用率無法取得... 真傷腦筋... 您有什麼好方法嗎? 還是兩個函數我使用不對...? 謝謝! DHM

計算CPU usage 就是計算某間隔時間的使用率變化所以利用 GetProcessCPU, AddFileTimes 以timer每秒更新使用率 
<textarea class="delphi" rows="10" cols="60" name="code"> var dtStart, dtCPUStart: TDatetime; procedure TForm1.Timer2Timer(Sender: TObject); begin if (dtStart<>0) and (dtCPUStart<>0) then begin Label2.Caption:=FloatToStr(-1*((GetProcessCPU-dtCPUStart)*100/(now-dtStart))); end; dtStart:=now; dtCPUStart:=GetProcessCPU; end; </textarea>
＠瞭解越多.懂得越少＠

您好，感謝您的指導。 但，我是指:如一個process 的程序名稱為 testprog.exe 之cpu使用率 如何取得? 謝謝您! DHM

------
ATEIN

由於GetProcessTimes第一個參數就是你要計算usage的process handle 可以知道你需要一個可以列舉所有process 的動作比對所有列舉出來的process 執行檔名把該process 的 handle 丟入GetProcessTimes 就是你所需要的了 列舉所有process可以參考【Program Name、PID、Window Handle、hProcess 的轉換函式】 http://delphi.ktop.com.tw/topic.php?topic_id=61654 這裡我改用原來的TFileTime 來計算KernelTime , UserTime 並參考SDK說明 TFileTime以large_integr來換為int64 所有時間計算都是同一種單位 Filetime-> large_integer-> Int64 ps.因為轉換成TDatetime 算出來就是不知怎麼地怪怪的
<textarea class="delphi" rows="10" cols="60" name="code"> unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, CommonUtil; type TForm1 = class(TForm) Label2: TLabel; Timer1: TTimer; Edit1: TEdit; Button1: TButton; procedure Timer1Timer(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; dtStart, dtCPUPrev: Int64; hProcess: THandle; iCount:integer; implementation {$R *.dfm} function GetProcessCPU(hP: THandle): Int64; var CreationTime, ExitTime, KernelTime, UserTime: TFileTime; kernel_LARGE, user_LARGE: LARGE_INTEGER; begin Result := 0; if hP > 0 then begin GetProcessTimes(hP, CreationTime, ExitTime, KernelTime, UserTime); kernel_LARGE.LowPart := KernelTime.dwLowDateTime; kernel_LARGE.HighPart := KernelTime.dwHighDateTime; user_LARGE.LowPart := UserTime.dwLowDateTime; user_LARGE.HighPart := UserTime.dwHighDateTime; Result := kernel_LARGE.QuadPart user_LARGE.QuadPart; end; end; function DateTimeToInt64(dt: TDatetime): Int64; var systemtime1: TSystemTime; filetime1: TFileTime; large1: LARGE_INTEGER; begin DatetimeToSystemTime(dt, systemtime1); SystemTimeToFileTime(systemtime1, filetime1); large1.LowPart := filetime1.dwLowDateTime; large1.HighPart := filetime1.dwHighDateTime; Result := large1.QuadPart; end; procedure TForm1.Timer1Timer(Sender: TObject); var timespan,dtProcess: Int64; begin if (iCount > 0) then begin timespan := DateTimeToInt64(now) - dtStart; if timespan > 0 then begin dtProcess := GetProcessCPU(hProcess) - dtCPUPrev; Label2.Caption := FloatToStr(100 * (dtProcess / timespan)) ' %'; end; end; dtStart := DateTimeToInt64(now); dtCPUPrev := GetProcessCPU(hProcess); Inc(iCount); end; procedure TForm1.Button1Click(Sender: TObject); begin timer1.Enabled := False; iCount:=0; hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, false, GetPIDByProgramName(Edit1.Text, True)); if hProcess > 0 then timer1.Enabled := True; end; end. </textarea>
＠瞭解越多.懂得越少＠ 發表人 - chris_shieh 於 2005/03/10 12:33:37

謝謝您，您實在是高手級的師傅，終於解決了問題。 有您存在及參與，我相信此論壇會更加聲動的。 真的太謝謝您了。 DHM

------
ATEIN

引言: 由於GetProcessTimes第一個參數就是你要計算usage的process handle 可以知道你需要一個可以列舉所有process 的動作 比對所有列舉出來的process 執行檔名 把該process 的 handle 丟入GetProcessTimes 就是你所需要的了 列舉所有process可以參考 【Program Name、PID、Window Handle、hProcess 的轉換函式】 http://delphi.ktop.com.tw/topic.php?topic_id=61654 這裡我改用原來的TFileTime 來計算KernelTime , UserTime 並參考SDK說明 TFileTime以large_integr來換為int64 所有時間計算都是同一種單位 Filetime-> large_integer-> Int64 ps.因為轉換成TDatetime 算出來就是不知怎麼地怪怪的

unit Unit1;    interface    uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, CommonUtil;    type
  TForm1 = class(TForm)
    Label2: TLabel;
    Timer1: TTimer;
    Edit1: TEdit;
    Button1: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;    var
  Form1: TForm1;
  dtStart, dtCPUPrev: Int64;
  hProcess: THandle;
  iCount:integer;    implementation    {$R *.dfm}    function GetProcessCPU(hP: THandle): Int64;
var
  CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
  kernel_LARGE, user_LARGE: LARGE_INTEGER;
begin
  Result := 0;
  if hP > 0 then
  begin
    GetProcessTimes(hP, CreationTime, ExitTime, KernelTime, UserTime);
    kernel_LARGE.LowPart := KernelTime.dwLowDateTime;
    kernel_LARGE.HighPart := KernelTime.dwHighDateTime;
    user_LARGE.LowPart := UserTime.dwLowDateTime;
    user_LARGE.HighPart := UserTime.dwHighDateTime;
    Result := kernel_LARGE.QuadPart   user_LARGE.QuadPart;
  end;
end;    function DateTimeToInt64(dt: TDatetime): Int64;
var
  systemtime1: TSystemTime;
  filetime1: TFileTime;
  large1: LARGE_INTEGER;
begin
  DatetimeToSystemTime(dt, systemtime1);
  SystemTimeToFileTime(systemtime1, filetime1);
  large1.LowPart := filetime1.dwLowDateTime;
  large1.HighPart := filetime1.dwHighDateTime;
  Result := large1.QuadPart;
end;    procedure TForm1.Timer1Timer(Sender: TObject);
var
  timespan,dtProcess: Int64;
begin
  if (iCount > 0) then
  begin
    timespan := DateTimeToInt64(now) - dtStart;
    if timespan > 0 then
    begin
      dtProcess := GetProcessCPU(hProcess) - dtCPUPrev;
      Label2.Caption := FloatToStr(100 * (dtProcess / timespan))   ' %';
    end;
  end;
  dtStart := DateTimeToInt64(now);
  dtCPUPrev := GetProcessCPU(hProcess);
  Inc(iCount);
end;    procedure TForm1.Button1Click(Sender: TObject);
begin
  timer1.Enabled := False;
  iCount:=0;
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, false, GetPIDByProgramName(Edit1.Text, True));
  if hProcess > 0 then
    timer1.Enabled := True;
end;    end.    

＠瞭解越多.懂得越少＠ 發表人 - chris_shieh 於 2005/03/10 12:33:37

另外再請問，為什麼label2 的caption 顯示都跳來跳去，是否要加buffer嗎? 請問如何讓它的訊息可以保留最新的值，但又不會跳動，較穩定的方式來顯示它呢?。 謝謝您。 DHM

引言: 另外再請問，為什麼label2 的caption 顯示都跳來跳去，是否要加buffer嗎? 請問如何讓它的訊息可以保留最新的值，但又不會跳動，較穩定的方式來顯示它呢?。

我不會出現這種情況 不知道你更新的timer interval 是多少 設定1000應該不會跳動太厲害 如果設定太小而且剛好又一直變化 就會一直跳動 ＠瞭解越多.懂得越少＠

我的經驗是:若取樣間隔太快，就必需建立Buffer 來緩衝它 如RS232的接收資料一般 問要如何建立BUFFER 來緩衝呢? 謝謝您。 DHM

------
ATEIN

Delphi 7 Enterpise 好像沒有 CommonUtil 這個元件耶

===================引 用 文 章===================

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, CommonUtil;    

------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！

子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！