Levantar processos em execução no Windows

Olá.

Percebi um e-mail muito interessante sobre como listar os processos ativos no Windows e fiz uma rotina em cima.

Estou compartilhando pois realmente achei interessante.

function InformacoesSobreProcessos(out ListagemCSV: TStringList): Boolean;
function StatusDoProcesso(PID: DWORD): string;
var
retorno   : Longint;
resultado : DWORD;
begin
Result := 'Indeterminado';
if (PID > 0) then
begin
retorno := SendMessageTimeout(PID,WM_NULL,0,0,SMTO_ABORTIFHUNG and SMTO_BLOCK,5000,resultado);
case retorno of
1 : Result := 'Em execução';
0 : Result := 'Não respondendo';
else Result := Format('%d?',[retorno]);
end;
end;
end;

procedure LocalizarProcessos;
var
controle  : DWORD;
continuar : Boolean;
alca      : THandle;
processo  : TProcessEntry32;
begin
controle        := 0;
alca            := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
processo.dwSize := SizeOf(TProcessEntry32);
continuar       := Process32First(alca,processo);
while (continuar) do
begin
controle := processo.th32ProcessID;
ListagemCSV.Add(Format('%s,%s',[processo.szExeFile,StatusDoProcesso(controle)]));
continuar := Process32Next(alca,processo);
end;
end;

begin
Result := False;
ListagemCSV.Clear;
LocalizarProcessos;
Result := True;
end;