Listing the running applications with memory & processor usage

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.
LVL 14
EsopoAsked:
Who is Participating?
 
Amir AzhdariConnect With a Mentor Commented:
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
 
shaneholmesCommented:
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
 
shaneholmesCommented:
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
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
EsopoAuthor Commented:
Shane, this will list all running process and the button tells the creation time, is that right?
0
 
shaneholmesCommented:
Yes, bu there are other variables as well:

lpExitTime, lpKernelTime, lpUserTime

Shane
0
 
EsopoAuthor Commented:
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
 
EsopoAuthor Commented:
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
 
shaneholmesCommented:
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
 
shaneholmesCommented:
Did you look at the properties of TProcessEntry32;

var
 ProcessEntry : TProcessEntry32;

Shane
0
 
shaneholmesCommented:
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
 
shaneholmesCommented:
Yup, all those applications (ToolHelp Viewer), and their source code is available in the download (JCL)

Shane
0
 
EsopoAuthor Commented:
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
All Courses

From novice to tech pro — start learning today.