Checar se processo já está executando e sair caso verdadeiro

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

tchadrack
Usuário Nível 1
Usuário Nível 1
Mensagens: 27
Registrado em: 15 Mar 2016 15:42
Localização: São Paulo

Checar se processo já está executando e sair caso verdadeiro

Mensagem por tchadrack »

Como fazer para checar o processo (programa) já está em execução
e abortar a inicialização caso já exista?

O objetivo é permitir que o usuário abra o programa apenas uma vez.

No Delphi isto é muito simples, mas eu tenho um programa feito no harbour e estou precisando implementar isto..
Avatar do usuário
Jairo Maia
Moderador
Moderador
Mensagens: 2785
Registrado em: 16 Ago 2010 13:46
Localização: Campinas-SP

Checar se processo já está executando e sair caso verdadeiro

Mensagem por Jairo Maia »

Olá tchadrack,

Seja bem vindo ao fórum.

Há várias formas, mas eu uso como está nesse exemplo. Para funcionar você precisa colocar em seu aplicativo as funções EstaAberto( cParam ) e a função em C Win_PegaProcessos() que estão no exemplo abaixo:

Código: Selecionar todos

/*
   Ao passar o nome do aplicativo, tem que ser completo: Nome e extensão.
   Exemplo: MeuProg.Exe
*/
Function Main()

 If EstaAberto( "NomeAplicativo.Extensao" )  // verifica se está aberto...

  Hb_Alert( "Programa ja em Execucao!" )
  Quit                                       // se sim, fecha esta copia...

 Else

  Hb_Alert( "Aplicativo nao estava em execucao" )

 EndIf

Return Nil


Func EstaAberto( cQuem )
 Local aProcs := {}, nReturn, nPosi := 0

 nReturn := Win_PegaProcessos( aProcs )
 If nReturn != 0
  Hb_Alert("Erro tentando obter a lista de processos.")
  Return .t.
 EndIf
 
 cQuem := Upper( cQuem )
 nPosi := AScan( aProcs, { |x| Upper( x[1] ) == cQuem } )

Return ( nPosi > 0 )  // Se está aberto retorna .t.

#pragma BEGINDUMP
#include <windows.h>
#include <windef.h>
#include <tlhelp32.h>
#include <hbapi.h>
#include <hbapiitm.h>

/*
  WIN_PEGAPROCESSOS( aArray ) -> nResult
  Baseada na função: WIN_GETPROCESSLIST() by Vailton Renato - 15/12/2009 - 18:58:58
*/

HB_FUNC( WIN_PEGAPROCESSOS )
{
  HANDLE hProcessSnap;
  PROCESSENTRY32 pe32;
  PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
  const char * szAppName = hb_parcx(2);
  BOOL bCanAdd = TRUE;

   if( !pArray )
   {
      hb_retni( 1 );
      return;
   }

  // Take a snapshot of all processes in the system.
  hProcessSnap = CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 );

  if( hProcessSnap == INVALID_HANDLE_VALUE )
  {
    // CreateToolhelp32Snapshot (of processes)
    hb_retni( 2 );
    return;
  }

  // Set the size of the structure before using it.
  pe32.dwSize = sizeof( PROCESSENTRY32 );

  // Retrieve information about the first process,
  // and exit if unsuccessful
  if( !Process32First( hProcessSnap, &pe32 ) )
  {
    hb_retni( 3 );
    CloseHandle( hProcessSnap );          // clean the snapshot object
    return;
  }

  // Ignores a empty string on seconds argument
  if ( hb_parclen(2) < 1 )
      szAppName = NULL;

  // Now walk the snapshot of processes, and
  // display information about each process in turn
  do
  {
    PHB_ITEM pSubarray;

    if (szAppName)
      bCanAdd = ( hb_stricmp( szAppName, pe32.szExeFile ) == 0 );

    if (bCanAdd)
    {
       pSubarray = hb_itemNew( NULL );

       hb_arrayNew( pSubarray, 1 );
       hb_arraySetC    ( pSubarray, 1, pe32.szExeFile );   // Process Name
       
       hb_arrayAddForward( pArray, pSubarray );
       
    }
  } while( Process32Next( hProcessSnap, &pe32 ) );

  CloseHandle( hProcessSnap );
  hb_retni( 0 );
  return;
}
#pragma ENDDUMP
Abraços, Jairo
Harbour / Clipper 5.2e - Blinker 7
(Não respondo dúvidas por MP ou E-mail. Por favor, não encaminhe via mensagem privada ou e-mail, dúvidas que podem ser compartilhadas com todos no fórum)
Avatar do usuário
Eolo
Colaborador
Colaborador
Mensagens: 1134
Registrado em: 08 Dez 2005 18:24
Localização: São Paulo - SP

Checar se processo já está executando e sair caso verdadeiro

Mensagem por Eolo »

Um outro jeito, arroz-com-feijão, sem muita firula, mas que funciona. Local ou rede.
Os experts podem torcer o nariz, mas funciona.

Quando o Usuário1 acessa o Programa.EXE, o EXE abre um TXT qualquer em modo EXCLUSIVO.
Se o mesmo Usuário1 tentar abrir o EXE em outra instância, não vai conseguir. Acesso negado.
Se o Usuário2 tentar acessar o EXE aberto pelo 1, vai dar pau. Acesso negado.

Quando o Usuário1 fechar a sessão (ou faltar luz), o acesso ao TXT vai estar liberado pra quem chegar primeiro.
Simples assim.

É só incluir estas linhas no início do EXE (funciona em Harbour e Clipper):

Código: Selecionar todos

arq="c:\qualquerpasta\acesso.txt"
if !file(arq)
  * se não existe, cria (usado apenas na primeira execução)
  arqh=fcreate(arq,0)
  if !arqh>0
    * se não conseguir criar, aborta
    ? "Erro ao Iniciar Acesso"
    quit
  endi
  * criou o arquivo
  txt="Qualquer coisa"
  txt_t=fwrite(arqh,txt) // escreve "Qualquer coisa" no arquivo criado
  if !txt_t=len(txt)
    * se não conseguir gravar, aborta
    ? "Erro ao Iniciar Acesso"
    quit
  endi
  * gravou
  fclose(arqh) // fecha
endi
janela=fopen(arq,18) // abre "qualquer.txt" em modo EXCLUSIVO, local ou rede
if !janela>0
  * não conseguiu abrir exclusivo
  ? "Programa aberto em outra janela"
  * ou "Tem outro usuário usando o EXE..."
  quit
endi
Responder