Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Trucos (https://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Evitar multiples instancias de nuestra aplicacion (https://www.clubdelphi.com/foros/showthread.php?t=80901)

casacham 06-04-2009 07:47:14

Evitar multiples instancias de nuestra aplicacion
 
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 22-06-2010 19:43:15

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 04-02-2011 19:27:16

Muy util, excelente

ramflores 26-04-2011 18:04:25

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

casacham 08-08-2011 02:06:34

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

radenf 20-10-2012 20:42:16

Excelente aporte casacham
Se agradece enormemente

rretamar 25-10-2012 02:06:35

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 29-01-2021 06:04:14

Evitar multiples instancias de nuestra aplicacion
 
Excelente!!! Es justo lo que andaba buscando para implementarlo en mi sistema...
Muchas gracias...

chenech 20-04-2022 00:28:10

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

Código:

  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);
  }



La franja horaria es GMT +2. Ahora son las 10:02:43.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi