Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Listing the running applications with memory & processor usage

Posted on 2004-04-06
14
Medium Priority
?
232 Views
Last Modified: 2010-04-05
Please check the original Q at:
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20940915.html


points for this particular Q will not be awarded, I'll ask for it's deletion in a couple of days.

Thank you.
0
Comment
Question by:Esopo
  • 8
  • 4
13 Comments
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10770846
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

 function GetWindowHandle(ProcessID: DWORD): HWND;
 function GetProcessID(ExeFile: String): DWORD;
 function FileTimeToDateTime(FileTime : TFileTime) : TDateTime;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function FileTimeToDateTime(FileTime : TFileTime) : TDateTime;
var
  SysTime : TSystemTime;
begin
  FileTimeToSystemTime(FileTime, SysTime);
  with SysTime do
    Result := EncodeDate(wYear, wMonth, wDay)
              + EncodeTime(wHour, wMinute, WSecond, wMilliseconds);
end;


function GetProcessID(ExeFile: String): DWORD;
var
  Snapshot: THandle;
  ProcessEntry: TProcessEntry32;
begin
  Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snapshot <> 0 then
  try
    ProcessEntry.dwSize := SizeOf(ProcessEntry);
    if Process32First(Snapshot, ProcessEntry) then
    repeat
      if AnsiCompareText(ExeFile, ProcessEntry.szExeFile) = 0 then
      begin
        Result := ProcessEntry.th32ProcessID;
        Exit;
      end;
    until not Process32Next(Snapshot, ProcessEntry);
  finally
    CloseHandle(Snapshot);
  end;
  Result := 0;
end;

function GetWindowHandle(ProcessID: DWORD): HWND;
var
  Handle: HWND;

  function EnumWindowProc(hwnd: HWND; lParam: LPARAM): BOOL;
  var
    ProcessID: DWORD;
  begin
    GetWindowThreadProcessId(hwnd, @ProcessID);
    Result := (ProcessID <> DWORD(lParam));
    if not Result then
      Handle := HWND;
  end;

begin
  if EnumWindows(@EnumWindowProc, ProcessID) then
    Result := Handle
  else
    Result := 0;
end;



procedure TForm1.FormActivate(Sender: TObject);
var
  hSnapshot : THandle;
  ProcessEntry : TProcessEntry32;
  done : BOOL;
begin
  try
    hSnapshot := CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
    ProcessEntry.dwSize := sizeof( TProcessEntry32 );
    done := Process32First( hSnapshot, ProcessEntry );
    while ( done = true ) do begin
     ListBox1.Items.Add((ProcessEntry.szExeFile));
      done := Process32Next( hSnapshot, ProcessEntry );
    end;
  finally
    CloseHandle( hSnapshot );
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 PH : THandle;
 hProcess : THandle;
 lpCreationTime,
 lpExitTime,
 lpKernelTime,
 lpUserTime : TFileTime;
begin
  hProcess:= GetProcessId(ListBox1.Items[ListBox1.ItemIndex]);
  PH := OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, hProcess);
  if PH <> 0 then
  GetProcessTimes(PH, lpCreationTime, lpExitTime, lpKernelTime, lpUserTime);
  ShowMessage(DateTimeToStr(FileTimeToDateTime(lpCreationTime)));
end;

end.
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10770902
Sorry,

//select  process in Listbox and click button
procedure TForm1.Button1Click(Sender: TObject);
var
 PH : THandle;
 hProcess : THandle;
 lpCreationTime,
 lpExitTime,
 lpKernelTime,
 lpUserTime : TFileTime;
begin
  hProcess:= GetProcessId(ListBox1.Items[ListBox1.ItemIndex]);
  PH := OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, hProcess);
  if PH <> 0 then
  GetProcessTimes(PH, lpCreationTime, lpExitTime, lpKernelTime, lpUserTime);
  //example of showing TFileTime variable
  ShowMessage(DateTimeToStr(FileTimeToDateTime(lpCreationTime)));
end;

Shane
0
 
LVL 14

Author Comment

by:Esopo
ID: 10770954
Shane, this will list all running process and the button tells the creation time, is that right?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 11

Expert Comment

by:shaneholmes
ID: 10770977
Yes, bu there are other variables as well:

lpExitTime, lpKernelTime, lpUserTime

Shane
0
 
LVL 14

Author Comment

by:Esopo
ID: 10771012
Yes, i was looking into that. I did a simple changing with the lpCreationTime in the ShowMessage in your code, but the resulting numbers I don't get.
What are lpExitTime, lpKernelTime, lpUserTime, and how can I use them?
0
 
LVL 14

Author Comment

by:Esopo
ID: 10771122
I was actually reading that article, but although it explains how to use the values, it doesn't explain what Kernel mode and User mode are. Do you know?

I'll keep researching.
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10771161
No I don't sorry!

However, if you search google groups foe (Delphi +  lpCreationTime) or any of the other values, you will see some of the information that is gathered using these values - Example , Computing CPU useage time, etc.

Shane
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10771382
Did you look at the properties of TProcessEntry32;

var
 ProcessEntry : TProcessEntry32;

Shane
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10771415
I just found this


http://www.volweb.cz/pvones/delphi/
http://www.volweb.cz/pvones/delphi/ToolHlpViewer.htm

It says the code can be downloaded from the JEDI page

http://delphi-jedi.org/Jedi:JCLDOWNLOADS

Im gonna download it and look!

Shane
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10771427
Yup, all those applications (ToolHelp Viewer), and their source code is available in the download (JCL)

Shane
0
 
LVL 6

Accepted Solution

by:
Amir Azhdari earned 400 total points
ID: 10772624
hi Esopo , some changes to shaneholmes's code , it'll retrieve memory usage for each process(don't forget to use psapi unit)


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TLHelp32, StdCtrls,psapi;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Label1: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

 function GetProcessID(ExeFile: String): DWORD;
 function FileTimeToDateTime(FileTime : TFileTime) : TDateTime;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function FileTimeToDateTime(FileTime : TFileTime) : TDateTime;
var
  SysTime : TSystemTime;
begin
  FileTimeToSystemTime(FileTime, SysTime);
  with SysTime do
    Result := EncodeDate(wYear, wMonth, wDay)
              + EncodeTime(wHour, wMinute, WSecond, wMilliseconds);
end;


function GetProcessID(ExeFile: String): DWORD;
var
  Snapshot: THandle;
  ProcessEntry: TProcessEntry32;
begin
  Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snapshot <> 0 then
  try
    ProcessEntry.dwSize := SizeOf(ProcessEntry);
    if Process32First(Snapshot, ProcessEntry) then
    repeat
      if AnsiCompareText(ExeFile, ProcessEntry.szExeFile) = 0 then
      begin
        Result := ProcessEntry.th32ProcessID;
        Exit;
      end;
    until not Process32Next(Snapshot, ProcessEntry);
  finally
    CloseHandle(Snapshot);
  end;
  Result := 0;
end;


procedure TForm1.FormActivate(Sender: TObject);
var
  hSnapshot : THandle;
  ProcessEntry : TProcessEntry32;
  done : BOOL;
begin
  try
    hSnapshot := CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
    ProcessEntry.dwSize := sizeof( TProcessEntry32 );
    done := Process32First( hSnapshot, ProcessEntry );
    while ( done = true ) do begin
     ListBox1.Items.Add((ProcessEntry.szExeFile));
      done := Process32Next( hSnapshot, ProcessEntry );
    end;
  finally
    CloseHandle( hSnapshot );
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 PH : THandle;
 hProcess : THandle;
 lpCreationTime,
 lpExitTime,
 lpKernelTime,
 lpUserTime : TFileTime;
 pmc:pprocess_memory_counters;
 cb:integer;

begin
  hProcess:= GetProcessId(ListBox1.Items[ListBox1.ItemIndex]);
  PH := OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, hProcess);
  if PH <> 0 then
  GetProcessTimes(PH, lpCreationTime, lpExitTime, lpKernelTime, lpUserTime);


// ********************* Memory Usage ********
cb:=sizeof(_process_memory_counters);
getmem(pmc,cb);
pmc^.cb:=cb;
if getprocessmemoryinfo(PH,pmc,cb)then
label1.caption:=inttostr(pmc^.WorkingSetSize)+' Bytes'
else
label1.caption:='unable to retrieve memory usage structure';
freemem(pmc);

// *****************************

  ShowMessage(DateTimeToStr(FileTimeToDateTime(lpCreationTime)));

end;


end.
0
 
LVL 14

Author Comment

by:Esopo
ID: 11642163
Hey guys!

I'm back. I know I deserve a name-calling session for leaving this Q out in the open for so long, but I had some issues that parted me from the net for a while.

Anyway, I'm back, got my hands on this project again and plan to see it through very soon. I'll be burning my brain with the code, hopefully we can come up with a function that will serve the delphi community for many years to come... (I feel I owe, you know?)

I'll be back with my findings very soon.

Esopo.
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
Suggested Courses

877 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question