News & Events
Dica: Verificado processos no Windows
- 3 de junho de 2008
- Posted by: Adriano Santos
- Category: delphi delphi2006 delphi2007 dicas
Dica: Verificando processos no Windows
Hoje é dia das dicas. Mais uma enviada pelo colega Rubem Nascimento. Dessa vez a dica são funções para listar e verificar se o processo está ou não respondendo. Vamos lá:
Crie uma nova aplicação e nessa declare um novo tipo e uma constante como segue:
type
__TProcessStatus = (pcsNotFound = -1, pcsNotResponding, pcsRunning);
const
__ProcessStatusNames : array[TProcessStatus] of string =
(‘** NÃO ENCONTRADO **’, ‘Em Execução’, ‘Não Respondendo’);
Em seguida declare e implemente as funções abaixo na área public:
function ProcessResponding(AProcessName: string): TProcessStatus;
procedure FindProcesses(Process: TStrings);
Veja trecho de código das declarações e implementações:
unit uResidencialKiller;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Types, Psapi, tlhelp32, StdCtrls;
type
TProcessStatus = (pcsNotFound = -1, pcsNotResponding, pcsRunning);
const
ProcessStatusNames : array[TProcessStatus] of string =
('** NÃO ENCONTRADO **', 'Em Execução', 'Não Respondendo');
...
private
{ Private declarations }
function ProcessResponding(
AProcessName: string): TProcessStatus;
procedure FindProcesses(Process: TStrings);
end;
...
procedure TfrmResidencialKiller.FindProcesses(Process: TStrings);
var
ContinueLoop : BOOL;
FSnapshotHandle : THandle;
FProcessEntry32 : TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while ContinueLoop {and (not Boolean(Result))} do
begin
Process.Add(FProcessEntry32.szExeFile);
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
end;
function FindProcess(ProcessName: string): DWORD;
var
ContinueLoop : BOOL;
FSnapshotHandle : THandle;
FProcessEntry32 : TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while ContinueLoop and (not Boolean(Result)) do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ProcessName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ProcessName))) then
Result := FProcessEntry32.th32ProcessID;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
end;
function TfrmResidencialKiller.ProcessResponding(
AProcessName: string): TProcessStatus;
var
H : DWORD;
lngReturnValue : longint;
DWResult : DWORD;
begin
Result := pcsNotFound;
H := FindProcess(AProcessName);
if H > 0 then
begin
lngReturnValue :=
SendMessageTimeout(H, WM_NULL, 0, 0, SMTO_ABORTIFHUNG and SMTO_BLOCK,
1000, DWResult);
Result := TProcessStatus(Ord((lngReturnValue > 0)));
end;
end;
...
Para utilização, insira dois botões e um listbox na tela. No primeiro botão codifique como baixo:
FindProcesses(ListBox1.Items);
No segundo:
procedure TfrmResidencialKiller.Button2Click(Sender: TObject);
begin
if ListBox1.ItemIndex <> -1 then
case ProcessResponding(ListBox1.Items[ListBox1.ItemIndex]) of
pcsNotFound: ShowMessage(Pr
ocessStatusNames[pcsNotFound]);
pcsNotResponding: ShowMessage(ProcessStatusNames[pcsNotResponding]);
pcsRunning: ShowMessage(ProcessStatusNames[pcsRunning]);
end;
end;
Veja uma imagem:
Donwload: Exemplo Process Killer
Adriano Santos
Editor Técnico Revista ClubeDelphi e WebMobile
Siga @tdevrocks no Twitter agora e fique por dentro de todas as atualizações do blog.
Siga também o autor @asrsantos
![foto](http://www.tdevrocks.com.br/wp-content/uploads/2016/11/adriano-santos.png)
Muito boa! Mas essa rotina também funciona para pegar processos de outra maquinas na mesma rede?
Grato.
andreylh@gmail.com
Muito bom cara …
Procurei por isso e não achei … valeu mesmo pela ajuda !!
Resolveu os meu problemas …
Abs.
Testei aqui cara, e quando um processo para de executa fala como se estivesse em execução.