Evitar multiples instancias de nuestra aplicacion

[casacham]

Este truco lo encontre navegando por internet y fue uno de esos descubribientos al azar con los que a veces uno se topa. El objetivo del siguiente codigo es evitar que nuestro programa sea abierto mas de una vez en el ordenador. Es decir evitar multiples instancias de nuestro programa.

Primero creen una nueva Unit y coloquen el siguiente codigo dentro de ella

Código Delphi [-]
unit CheckPrevious;

interface
uses Windows, SysUtils;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;

implementation

type
  PInstanceInfo = ^TInstanceInfo;
  TInstanceInfo = packed record
    PreviousHandle : THandle;
    RunCounter : integer;
  end;

var
  MappingHandle: THandle;
  InstanceInfo: PInstanceInfo;
  MappingName : string;

  RemoveMe : boolean = True;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;
begin
  Result := True;

  MappingName :=StringReplace(ParamStr(0),'\','',[rfReplaceAll, rfIgnoreCase]);

  MappingHandle := CreateFileMapping($FFFFFFFF,
                                     nil,
                                     PAGE_READWRITE,
                                     0,
                                     SizeOf(TInstanceInfo),
                                     PChar(MappingName));

  if MappingHandle = 0 then
    RaiseLastOSError
  else
  begin
    if GetLastError <> ERROR_ALREADY_EXISTS then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle,
                                    FILE_MAP_ALL_ACCESS,
                                    0,
                                    0,
                                    SizeOf(TInstanceInfo));

      InstanceInfo^.PreviousHandle := AppHandle;
      InstanceInfo^.RunCounter := 1;

      Result := False;
    end
    else //already runing
    begin
      MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
      if MappingHandle <> 0 then
      begin
        InstanceInfo := MapViewOfFile(MappingHandle,
                                      FILE_MAP_ALL_ACCESS,
                                      0,
                                      0,
                                      SizeOf(TInstanceInfo));

        if InstanceInfo^.RunCounter >= MaxInstances then
        begin
          RemoveMe := False;

          if IsIconic(InstanceInfo^.PreviousHandle) then
            ShowWindow(InstanceInfo^.PreviousHandle, SW_RESTORE);
          SetForegroundWindow(InstanceInfo^.PreviousHandle);
        end
        else
        begin
          InstanceInfo^.PreviousHandle := AppHandle;
          InstanceInfo^.RunCounter := 1 + InstanceInfo^.RunCounter;

          Result := False;
        end
      end;
    end;

  end;
end;

initialization

finalization
  //remove one instance
  if RemoveMe then
  begin
    MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
    if MappingHandle <> 0 then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle,
                                  FILE_MAP_ALL_ACCESS,
                                  0,
                                  0,
                                  SizeOf(TInstanceInfo));

      InstanceInfo^.RunCounter := -1 + InstanceInfo^.RunCounter;
    end
    else
      RaiseLastOSError;
  end;

  if Assigned(InstanceInfo) then UnmapViewOfFile(InstanceInfo);
  if MappingHandle <> 0 then CloseHandle(MappingHandle);

end.

Segundo salven la unit con el nombre CheckPrevious

Tercero ahora deben incluirla en cualquiera de sus proyectos y hacer un agregado al codigo en el archivo de proyecto de su aplicacion como se ve aqui abajo. Recuerde que para agregar esta unit a su proyecto recomiendo copiar su archivo a la misma carpeta en la que esta su aplicacion en desarrollo y luego agregarla con Add file to proyect pulsando en delphi 2007 SHIFT+F11

Código Delphi [-]
program Obessologia08;

uses
  
  Forms,
  Controls,
  Windows,
  U_Prin                         in 'U_Prin.pas' {F_Prin},
  U_DM_Obess                     in 'U_DM_Obess.pas' {DM_Obess: TDataModule},
  FuncionesGlobales              in 'FuncionesGlobales.pas',
...
....
...
...
...
....

  U_AutoresVersion               in 'U_AutoresVersion.pas' {F_AutoresVersion},
  U_Producto                     in 'U_Producto.pas' {FProducto},
  U_Claves                       in 'U_Claves.pas' {FClaves},
  CheckPrevious                  in 'CheckPrevious.pas';

{$R *.res}
Var R: Integer;

begin
// Aqui va el agregado de la linea de CheckPrevious
 if not CheckPrevious.RestoreIfRunning(Application.Handle, 1) then begin
  Application.Initialize;
  Application.Title := 'Cirugía Metabólica DataSet';
  Application.MainFormOnTaskbar := True;
  try
    F_Login:=TF_Login.Create(Application);
    R      :=F_Login.ShowModal;
    F_Login.Free;
    if R = mrOK then begin
       Application.CreateForm(TDM_Obess, DM_Obess);
  Application.CreateForm(TF_Prin, F_Prin);
  Application.Run;
    end;
    if R = mrAbort then begin
       FNoAdmitido:=TFNoAdmitido.Create(Application);
       FNoAdmitido.ShowModal;
       FNoAdmitido.Free;
       F_AutoresVersion:=TF_AutoresVersion.Create(Application);
       F_AutoresVersion.ShowModal;
       F_AutoresVersion.Free;
       Application.Terminate;
    end;
  finally
    Application.Terminate;
  end;
 end;
end.

Otro ejemplo de su uso

Código Delphi [-]
program Mailing;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  VCLFixPack in 'VCLFixPack.pas',
  CheckPrevious in 'CheckPrevious.pas',
  ThreadSendMailer in 'ThreadSendMailer.pas';

{$R *.res}

begin
if not CheckPrevious.RestoreIfRunning(Application.Handle, 1) then
  begin
      Application.Initialize;
      Application.MainFormOnTaskbar := True;
      Application.Title := 'Enviar correos por smtp';
      Application.CreateForm(TForm1, Form1);
  Application.Run;
  end;
end.

[BrunoBsso]

Muy útil, me vino bárbaro.
Justo lo que necesitaba. También necesitaba, en otra aplicación, no el hecho de restaurar las instancias previas, sino simplemente evitar las nuevas. Pero tocando un poquito se logró.
Buen aporte!

[mantraxer21]

Muy util, excelente

[ramflores]

Gracias, excelente solución, me ha servido de mucho

[casacham]

Realmente me alegra poder hacer aportes a otros desarrolladores, muchas gracias por sus comentarios

[radenf]

Excelente aporte casacham
Se agradece enormemente

[[rretamar]]

Existe un componente para Lazarus llamado Uniqueinstance que hace lo mismo. Lo interesante de este componente es que funciona tanto en Windows como en Linux. Aquí se explica cómo instalarlo y usarlo:

http://wiki.freepascal.org/UniqueInstance/es

Este componente ya viene preinstalado en la distribución Lazarus Codetyphon.

[Armando Montiel]

Excelente!!! Es justo lo que andaba buscando para implementarlo en mi sistema...
Muchas gracias...

[chenech]

Por si alguien lo nececita en C++ Builder, añadir en la función main:

  const char UnicoNombre[] = "MiPrograma";
  HANDLE hHandle = CreateMutex(NULL, TRUE, UnicoNombre);
  if(ERROR_ALREADY_EXISTS == GetLastError()) {
    ShowMessage("El programa ya está en ejecución");
    return(1);
  }