terça-feira, 10 de março de 2009

Verificar se programa está em execução

Você desenvolveu seu programa, mas quer evitar que o mesmo seja aberto novamente quando já está em execução, ou não quer que seja executado enquanto outro processo estiver rodando, como fazer?

Aproveitando parte da rotina que postei no ínicio da semana sobre finalizar processos, criaremos uma rotina para apenas verificar se o processo existe ou não. Crie um novo projeto no Delphi, e declare já no code do projeto a seguinte função:

function TForm1.ProcessoExiste(ExeFileName: string): boolean;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32{declarar Uses Tlhelp32};
begin
result := false;

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
begin
Result := true;
exit;
end;
ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;


NOTA: declare a uses Tlhelp32

A função será o principal agente para varedura dos processos, onde adicionamos a lista de processos para a memória e depois, através de um While percorremos todos eles, localizando a entrada desejada. Ao encontrar o processo desejado, alteramos o resultado da função para True e abandonamos o while.

Para mostrar o resultado na tela, adicione um componente Edit (Edit1) e um Button (Button1), adicionando o código a seguir ao evento OnClick do Button:

procedure TForm1.Button1Click(Sender: TObject);
begin
if ProcessoExiste(Edit1.Text) then
ShowMessage('Processo encontrado')
else
ShowMessage('Processo não existe');
end;

Pronto, execute o projeto e faça o teste para verificar se o processo do explorer por exemplo está rodando, conforme demostração.
Abraço... até o próximo post.

8 comentários:

Anônimo disse...

caraaa! essa função me salvoooou!! =)

valew msmo!

parabens pelo blog!!

Eduardo FP disse...

Valew Manu....

E só tive um erro, mas consertei.Foi no:

function TForm1.ProcessoExiste(ExeFileName: string):
Esse deu errado no meu aqui....

function ProcessoExiste(ExeFileName: string):
Deu certo no meu...

Obs: Eu apaguei o TForm1. e só deixei o ProcessoExiste



Valeu cara ! \o/

Unknown disse...

Belo exemplo e com resultado garantido...
Valeu mesmo!

Só fiz uma alteração, pois no meu caso sempre acusava a aplicação em uso (formulário de senha). Solucionei inserindo um contador no lugar onde passa a variável para true. No final, seto a variável Result := contador > 1.

Sucesso a vc!

gutemberg disse...

só melhorei o código para realmente ficar só um em execução mesmo que que execute varias vezes o programa.

1 ° a função "ProcessoExiste" tem que retornar um inteiro e nao boolean

2° adicionar uma variavel que irá contar quantos processos do mesmo programa tem na lista, e fazer com que essa função retorene essa contagem.

3° no OnShow do formulário, verificar se a função retornou, maior que 1, se sim, fechamos o programa.

assim ficou a função modificada.


function TForm1.ProcessoExiste(ExeFileName: string): integer;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32{declarar Uses Tlhelp32};
count:integer;
begin
count:=0;
result := count;

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then

begin

count:=count+1;

//exit;
end;

ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);

Result := count;
end;



no evento OnShow do Formulario colocar assim.

if ProcessoExiste(ExtractFileName(Application.ExeName))> 1then

Form1.Close;

Maikel Scheid disse...

Olá gutemberg, obrigado pela contribuição. Abraço

Turbo Drive disse...

Ficou muito bom, com a contagem de processos. Dá até para se criar um log para sabermos quantas vezes tentaram executar a mesma aplicação. Parabéns.

Clayton Santos disse...

Fantástico....
Parabéns pela iniciativa!

Unknown disse...

tem como eu conseguir de outra maquina informando o ip da mesma e me retornar se esta rodando