Impedir ejecucion simultanea

[jconnor82]

De mucha utilidad la unidad, la uso desde hace tiempo , aunque realice unos cambios a la unidad para convertirla en funcion:

Código Delphi [-]
unit MclApplication;

interface

uses
  Windows, SysUtils, Forms;

// GENERALES -------------------------------------------------------------------

procedure ApplicationActive(Handle: HWND); overload;

procedure ApplicationActive; overload;

// One Instance ----------------------------------------------------------------

function InstanceExists(Identifier: string): Boolean;

implementation

// GENERALES -------------------------------------------------------------------

procedure ApplicationActive(Handle: HWND); overload;
var
  FgThreadId  : DWORD;
  AppThreadId : DWORD;
begin
  if IsIconic(Handle) then
    ShowWindow(Handle, SW_RESTORE)
  else
  begin
    { Obtener los hilos }
    FgThreadId  := GetWindowThreadProcessId(GetForegroundWindow, nil);
    AppThreadId := GetWindowThreadProcessId(Handle, nil);
    { Anexar el hilo de nuestra app. al de la  que tenga el foco }
    AttachThreadInput(AppThreadId, FgThreadId, true);
    { Ahora sí, InstanceActivar la applicación }
    SetForegroundWindow(Handle);
    { Separar el hilo de nuestra app de la otra }
    AttachThreadInput(AppThreadId, FgThreadId, false);
  end;
end;

procedure ApplicationActive;
begin
  ApplicationActive(Application.Handle);
end;

//------------------------------------------------------------------------------
// One Instance
//------------------------------------------------------------------------------

var
  mActivar    : Cardinal; { Mensaje para activar la instancia anterior }
  Mutex       : Cardinal; { Mutex }
  PrevWndProc : TFarProc; { Procedimiento de ventana original }

function AppWndProc(Handle: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LongInt; stdcall;
begin
  if Msg = mActivar then
  begin
    ApplicationActive(Handle);
    Result := 0;
  end else
    { Dejar que el procedimiento original se encargue de los otros mensajes }
    Result := CallWindowProc(PrevWndProc, Handle, Msg, wParam, lParam);
end;

procedure InstanceActivar;
begin
  { Mandamos el mensaje a todas las ventanas }
  SendMessage(HWND_BROADCAST, mActivar, 0, 0);
end;

procedure InstanceRegistrar(Identifier: string);
const
  { Cadenas para InstanceRegistrar el mutex y el mensaje }
  sMutex   = '10D73234-C9F7-4C2D-BC7E-39B5820AF456';
  sActivar = '3F154732-CCDE-4BC7-9439-AFCD3BCFA84D';
begin
  mActivar := RegisterWindowMessage(PChar(sActivar + Identifier));
  Mutex    := CreateMutex(nil, true, PChar(sMutex + Identifier));
  { Si ya existe el mutex lanzamos una excepción silenciosa }
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    Mutex := 0;
    Abort;
  end else
  begin
    { Sustituimos el procedimiento de ventana }
    PrevWndProc := TFarProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongWord(@AppWndProc));
  end;
end;

function InstanceExists(Identifier: string): Boolean;
begin
  Result := True;
  try
    InstanceRegistrar(Identifier);
    Result := False;
  except
    InstanceActivar;
//    Halt; //Termina la aplicacion
  end;
end;

initialization

finalization

  if Mutex <> 0 then ReleaseMutex(Mutex);

end.

un ejemplo de uso, en el dpr:

Código Delphi [-]
 program Project1;
 
 uses
   Forms,
   Unit1 in 'Unit1.pas' {Form1};
 
 {$R *.res}
 
 begin
   if InstanceExists('MI APLICACION') then
     Exit;
 
   Application.Initialize;
   Application.MainFormOnTaskbar := True;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
 end.

[Loviedo]

La función también va bien pero me veo obligado a cambiar el GUID siempre que haya más de una aplicación en el mismo PC, que es lo que pretende la mejora de SEOANE (no tener que cambiarlo) según he entendido.
Tengo dos aplicaciones en el mismo PC y efectivamente solo se ejecuta una sola instancia, pero si el GUID es el mismo, solo puedo ejecutar una de las dos.Simultaneamente no se puede.
Saludos.

[Loviedo]

Perdón. Funciona estupendamente.
Saludos.