En esta sección de Código fuente en Delphi vamos a mostrar cómo podemos realizar un listado de todas las aplicaciones que se encuentran ejecutandose en la memoria del equipo y cómo saber la ruta completa del ejecutable que ha arrancado nuestra app.

Para ello, he escrito esta pequeña app de ejemplo

Para conocer qué procesos están ejecutandose en memoria, existe una estructura definida en la unidad TlHelp32.pas llamada "TProcessEntry32". Esta estructura junto con las funciones "Process32First" y "Process32Next" es la que nos permite recorrer el listado de todos los procesos que en la actualidad se encuentran cargados en la memoria.

La estructura "TProcessEntry32" está definida de la siguiente forma en el archivo TlHelp32.pas:

type
  PProcessEntry32 = ^TProcessEntry32;
  TProcessEntry32 = record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ProcessID: DWORD;       // this process
    th32DefaultHeapID: DWORD;
    th32ModuleID: DWORD;        // associated exe
    cntThreads: DWORD;
    th32ParentProcessID: DWORD; // this process's parent process
    pcPriClassBase: Longint;	// Base priority of process's threads
    dwFlags: DWORD;
    szExeFile: array[0..MAX_PATH - 1] of Char;// Path
  end;

function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; stdcall;
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; stdcall;

De todos los campos de esta estructura, el campo denominado "th32ProcessID" es el que contiene el identificador de cada proceso en memoria, otro campo importante es el denominado "szExeFile" que contiene el nombre del archivo ejecutable correspondiente a ese proceso.

En la aplicación de ejemplo se realizan dos acciones distintas:

1. En el eventro FormCreate del Formulario realizamos un listado de todos los procesos cargados en memoria, mostrando el nombre del ejecutable junto con la ruta completa del mismo en un objeto TMemo.
2. Realizamos una busqueda del programa que ha arrancado nuestra aplicación. Para ello, utilizamos el campo "th32ParentProcessID" (identificador del proceso padre) de nuestro propio proceso. Una vez localizado el identificador de nuestro proceso y del proceso padre, buscamos el ejecutable que corresponde al segundo identificador con el uso de la función "GetPathFromPID" que también se encuentra definida en el código. Esta segunda acción la hemos asociado al evento OnClick de un botón y el resultado se muestra en un Label. La función utilizada la he llamado "GetParentProcessPath" y son simplemente dos llamadas consecutivas a las punciones "GetParentProcessId" (identificador del proceso padre) y "GetPathFromPID" a la que pasamos el resultado de la función anterior.

El bucle para recorrer todos los procesos en memoria lo conseguimos con las funciones "Process32First" y "Process32Next".

Ambas funciones devuelven un valor tipo boolean, este valor será el que nos indique si debemos repetir el bucle para continuar obteniendo nuevas entradas del tipo "TProcessEntry32", cada una de las cuales se corresponderá con un nuevo proceso en memoria, del cual prodremos usar cualquiera de sus campos según nos convenga (identificador propio, identificador padre, archivo ejecutable...).

En la siguiente imagen puedes ver un ejemplo de uso de esta app.

A continuación, puedes ver el código completo de la app, y si lo deseas puedes descargarlo todo (código y app) en un archivo "zip".

unit Unit1;


interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Memo1: TMemo;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ListarProcesosEnMemoria;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses tlhelp32, PsAPI;



//Para saber el Identificador del Proceso que ha arrancado nuestra app

function GetParentProcessID: DWORD;
var
  HandleSnapShot: THandle;
  FProcessEntry32: TProcessEntry32;
  CurrentProcessId: DWORD;
begin
  result := 0;
  HandleSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //enumerate the process
  if HandleSnapShot <> INVALID_HANDLE_VALUE then
  begin
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    if Process32First(HandleSnapShot, FProcessEntry32) then //find the first process
    begin
      CurrentProcessId := GetCurrentProcessId(); //get the id of the current process
      repeat
        if FProcessEntry32.th32ProcessID = CurrentProcessId then
        begin
          result := FProcessEntry32.th32ParentProcessID; //get the id of the parent process
          break;
        end;
      until not Process32Next(HandleSnapShot, FProcessEntry32);
    end;
    CloseHandle(HandleSnapShot);
  end;
end;

//Para obtener la ruta de un ejecutable por su Identificador de Proceso

function GetPathFromPID(const PID: cardinal): string;
var
  hProcess: THandle;
  Path: array[0..MAX_PATH - 1] of char;
begin
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, PID);
  if hProcess <> 0 then
  try
    if GetModuleFileNameEx(hProcess, 0, Path, SizeOf(Path)) <> 0 then
      Result := Path;
  finally
    CloseHandle(hProcess)
  end;
  //else
  //  raise Exception.Create('El Programa No Se Encuentra Activo en Memoria');
end;


//Para saber la ruta del archivo ejecutable que ha arrancado nuestra app

function GetParentProcessPath: string;
begin
  result := GetPathFromPID(GetParentProcessId);
end;


procedure TForm1.ListarProcesosEnMemoria;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  ruta: string;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do
  begin
    ruta := GetPathFromPID(FProcessEntry32.th32ProcessID);
    if ruta <> '' then Memo1.Lines.Add(FProcessEntry32.szExeFile + ' ==> ' + ruta);
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
  ListarProcesosEnMemoria;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := 'Ruta del programa que ha arrancado nuesta app: ' +
    GetParentProcessPath;
end;

end.