unit Unit1;
//{$mode objfpc}{$H+}
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, LazLogger,
ExtCtrls, Windows, LCLIntf, ComCtrls;
type
TFNWndEnumProc = function(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
function EnumWindows(lpEnumFunc: TFNWndEnumProc; lParam: LPARAM): BOOL;stdcall; external user32;
type
{ TForm1 }
TForm1 = class(TForm)
BitBtn1: TBitBtn;
Label1: TLabel;
ListView1: TListView;
Panel1: TPanel;
procedure BitBtn1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
function GetProcessImagePath(pid: DWORD): string;
var
hProcess: THandle;
path: array of Char;
pathSize: DWORD;
begin
Result := '';
// Determine required buffer size
pathSize := MAX_PATH;
SetLength(path, pathSize);
FillChar(path[0], Length(path) * SizeOf(Char), 0); // Initialize path
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, pid);
if hProcess <> 0 then
begin
try
try
// Query full process image name
if QueryFullProcessImageNameA(hProcess, 0, @path[0], @pathSize) then
begin
// Resize buffer if necessary
SetLength(path, pathSize);
// Convert buffer to string and assign to result
Result := string(path);
end
else
ShowMessage('QueryFullProcessImageNameA failed');
except on e: Exception do
ShowMessage('GetProcessImagePath Error: ' + E.Message);
end;
finally
CloseHandle(hProcess);
end;
end;
end;
// function uses EnumWindows to populate a listview with running windowed apps and useful info.
function EnumWindowsProc(WHandle: HWND; lv: TListView): BOOL;StdCall;
var Title,ClassName, FileName:array[0..128] of char;
li:TListItem;
PID:dword;
sPath:String;
begin
Result:=True;
sPath:='';
PID:=0;
GetWindowText(wHandle, Title,128);
GetClassName(wHandle, ClassName, 128);
GetModuleFileName(wHandle, FileName, 128); // not working
try
if Title<>'' then
begin // avoid returned programs without titles
if IsWindowVisible(wHandle) then begin // if true, this is a windowed application
li:= TListItem.Create(lv.Items); // create a new listitem
li.Caption:=inttostr(wHandle); // lets see the window handle
li.SubItems.Add(''); // the pid will go here
li.SubItems.Add(string(Title)); // add the window title
li.SubItems.Add(string(ClassName)); // the window class name
// get the pid using the wHandle
if GetWindowThreadProcessId(wHandle, @PID) <> 0 then
begin
li.SubItems[0]:=inttostr(PID); // lets see the pid
sPath:=GetProcessImagePath(PID); // this causes access violation on 2nd run or close of app
li.SubItems.Add(sPath); // add the file path to my list item subitems
end
else
li.SubItems.Add('Failed to retrieve PID for HWND: '+ inttostr(wHandle));
//to-do ExtractIcon(string(fileName));
lv.Items.AddItem(li); // add the row
result:=true;
end; // eo is window visible
end; // eo Title not blank
except
on e: Exception do ShowMessage('An exception was raised: ' + E.Message);
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if Assigned(ListView1) and Assigned(ListView1.Items) then
begin
ListView1.Items.BeginUpdate;
try
ListView1.Items.Clear; // Clear existing items
// Populate ListView1 with new items
EnumWindows(@EnumWindowsProc, LPARAM(ListView1));
finally
ListView1.Items.EndUpdate;
end;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
BitBtn1.OnClick := nil;
end;
end.
Recent
