Mostrando entradas con la etiqueta INSTANCIA. Mostrar todas las entradas
Mostrando entradas con la etiqueta INSTANCIA. Mostrar todas las entradas

miércoles, 15 de junio de 2016

Truco Delphi - Prevenir la ejecución de más de una instancia de nuestra aplicación (I)


Hace ya bastante tiempo que no posteo, pero eso no quiere decir que me haya olvidado de vosotros.
Como no dispongo de mucho tiempo para continuar con el curso de Lazarus y postear de forma asidua los artículos que tenía previstos, voy a empezar a postear pequeños tips y códigos de ejemplo para resolver pequeños problemas que me surgen en el día a día.

Hoy quiero mostraros como hacer que vuestra aplicación no se ejecute más de una vez, pero, en lugar de manteniendo la instancia más antigua, haciendo que la nueva instancia tome el control, es decir, que la nueva ejecución sustituya a la antigua.

Para ello nos vamos a basar en el procedimiento de WinApi GetCurrentProcessId, que nos dará el id de proceso del programa que estamos ejecutando y en el objeto TApplication para obtener el ExeName que será el que buscaremos.



Básicamente lo que pretendemos es terminar cualquier proceso que se llame como el nuestro, pero que no sea el nuestro :D


Añadimos el siguiente código en el evento OnCreate de nuestro formulario principal.

procedure TfrmPrincipal.FormCreate(Sender: TObject);
begin
  FProcessID := GetCurrentProcessId;
  FExeName   := ExtractFileName(Application.ExeName);
  
  CerrarInstancias;
end;

Este es el código que recorrerá todos los procesos de Windows y eliminará las instancias que existan de nuestra aplicación excepto la actual.

procedure TfrmPrincipal.CerrarInstancias;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  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(FExeName)) or
          (UpperCase(FProcessEntry32.szExeFile) =
          UpperCase(FExeName)))  and
         (FProcessEntry32.th32ProcessID <> FProcessID)
      then
      begin
        TerminateProcess(OpenProcess(PROCESS_TERMINATE,
                                    BOOL(0),
                                    FProcessEntry32.th32ProcessID),
                                    0);
      end;

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

end;

Mas adelante pondré otras maneras de prevenir la ejecución de más de una instancia de nuestras aplicaciones.
Compartir:
Con la tecnología de Blogger.

BoosterBlog

BoosterBlog
BoosterBlog

Timeline Twitter

Seguidores

Seguidores