Ver Mensaje Individual
  #1  
Antiguo 02-04-2015
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
Garantizar de 1..N Instancias Activas en Memoria por Aplicación para Delphi y Lazarus

Club Delphi,

Revisen el siguiente código en Delphi:
Código Delphi [-]
unit SingleInstance;

interface

implementation

uses SysUtils, Forms, Dialogs, Windows;

const
   MutexName : String = 'Test_SingleInstance_Delphi';

var
   Mutex : THandle;

procedure CheckInstance;
begin

   if OpenMutex(MUTEX_MODIFY_STATE,false,PChar(MutexName)) = 0 then
   begin
      Mutex := CreateMutex(nil,False,PChar(MutexName));
      WaitForSingleObject(Mutex,INFINITE);
   end
   else
   begin
      MessageDlg('Existe una Instancia de la Aplicación Activa en Memoria',mtInformation,[mbOk],0);
      Application.Terminate;
   end;

end;

procedure FreeInstance;
begin
   if Mutex <> 0 then
   begin
      ReleaseMutex(Mutex);
      CloseHandle(Mutex);
   end
end;

initialization
  CheckInstance;

finalization
  FreeInstance;

end.
El código anterior en Delphi 7 Sobre Windows 7 Professional x32, permite tener una sola instancia activa en memoria de una aplicación.

Revisen el siguiente código en Lazarus:
Código Delphi [-]
unit SingleInstance;

{$mode objfpc}{$H+}

interface

implementation

uses SysUtils, Forms, Dialogs, Windows;

const
   MutexName : String = 'Test_SingleInstance_Lazarus';

var
   Mutex : THandle;

procedure CheckInstance;
begin

   if OpenMutex(MUTEX_MODIFY_STATE,false,PChar(MutexName)) = 0 then
   begin
      Mutex := CreateMutex(nil,False,PChar(MutexName));
      WaitForSingleObject(Mutex,INFINITE);
   end
   else
   begin
      MessageDlg('Existe una Instancia de la Aplicación Activa en Memoria',mtInformation,[mbOk],0);
      Halt;
   end;

end;

procedure FreeInstance;
begin
   if Mutex <> 0 then
   begin
      ReleaseMutex(Mutex);
      CloseHandle(Mutex);
   end
end;

initialization
  CheckInstance;

finalization
  FreeInstance;

end.
El código anterior en Lazarus Versión #:1.2.6 FPC Version 2.6.4 bajo Windows 7 Professional x32 , permite tener una sola instancia activa en memoria de una aplicación.

Nota:

1- Para tener una sola instancia de una aplicación tanto en Delphi como en Lazarus, solo debe agregarse la unidad SingleInstance al proyecto Delphi/Lazarus, la unidad ejecutara de forma automática el procedimiento CheckInstance al inicializarce y el procedimiento FreeMutex al finalizar.

2- Básicamente el código de Delphi y Lazarus es el mismo, solo varía en la forma de finalizar la aplicación.

3- MutexName, es el nombre de la aplicación para efectos de exclusión el cual debe ser único para las funciones de Mutex.

Revisen esta información:
Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 02-04-2015 a las 23:33:50.
Responder Con Cita