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:
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:
caraaa! essa função me salvoooou!! =)
valew msmo!
parabens pelo blog!!
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/
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!
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;
Olá gutemberg, obrigado pela contribuição. Abraço
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.
Fantástico....
Parabéns pela iniciativa!
tem como eu conseguir de outra maquina informando o ip da mesma e me retornar se esta rodando
Postar um comentário