Evitar varias instancias de un programa.

La mayoría de la veces para que un programa funcione bien, es imprescindible que solo se ejecute una vez al mismo tiempo, es decir, permitir una única instancia de ejecución del programa.

El paquete UniqueInstance, nos permite agregar esta funcionalidad a nuestros programas, de manera sencilla.

Este paquete se puede instalar cómodamente desde OPM (On Line Package Manager) disponible en versiones de Lazarus 1.8.4 y posteriores.

Una vez instalado y reconstruida la IDE, el componente se encuentra en la paleta System, el círculo rojo con el número 1.

Se coloca en el formulario principal del programa.

En el inspector de objetos se lo activa y se le establece un identificador que, como se ve en la imagen, puede ser cualquier cadena de caracteres.

En eventos, solo hay uno, lo creamos presionando sobre los tres puntos.

procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject;
ParamCount: Integer; const Parameters: array of String);
begin
  ShowMessage('El programa ya se está ejecutando.');
  BringToFront;
  FormStyle:=fsSystemStayOnTop;
  FormStyle:=fsNormal;
end;

Ahí podemos hacer algo simple, como un showmessage y luego traer al frente el programa, dado que el usuario seguramente lo tenga minimizado y no lo vea.

Simple programa de ejemplo:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
UniqueInstance;

type

{ TForm1 }

TForm1 = class(TForm)
  Button1: TButton;
  UniqueInstance1: TUniqueInstance;
  procedure Button1Click(Sender: TObject);
  procedure UniqueInstance1OtherInstance(Sender: TObject;
  ParamCount: Integer; const Parameters: array of String);
private

public

end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject;
ParamCount: Integer; const Parameters: array of String);
begin
  ShowMessage('El programa ya se está ejecutando.');
  BringToFront;
  FormStyle:=fsSystemStayOnTop;
  FormStyle:=fsNormal;
end;

end.