No consigo impedir doble instancia del programa

[dec]

Empezado por roman

Hola dabas:

Si gustas puedes usar la unidad uiapp.pas en mi página. Como ahí menciono yo la uso diariamente en Window98, WindowMe y Windows2000 sin ningún problema.

Lo único que tienes que hacer es copiar el código y guardarlo como uiapp.pas (o el nombre que desees) e incluir la unidad al final de la cláusula uses del archivo dpr de tu proyecto.

// Saludos

Aquí la unidad en cuestión:

Código Delphi [-]
unit UIApp;

interface

implementation

uses
  Windows, SysUtils, Forms;

const
  { Cadenas para registrar el mutex y el mensaje }
  sMutex   = '5EF83655-5902-48D0-AC23-BF3C3B0610F9';
  sActivar = '95C30256-F47E-4E23-87AC-9B9C67C8D0C5';

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;
var
  FgThreadId  : DWORD; { Hilo de la app. que tenga el foco }
  AppThreadId : DWORD; { Hilo de nuestra aplicación        }

begin
  if Msg = mActivar then
  begin
    { Si está minimizada basta restaurarla }
    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í, activar la applicación }
      SetForegroundWindow(Handle);

      { Separar el hilo de nuestra app de la otra }
      AttachThreadInput(AppThreadId, FgThreadId, false);
    end;

    Result := 0;
  end
  else
    { Dejar que el procedimiento original se encargue de los otros mensajes }
    Result := CallWindowProc(PrevWndProc, Handle, Msg, wParam, lParam);
end;

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

procedure Registrar;
begin
  mActivar := RegisterWindowMessage(sActivar);
  Mutex    := CreateMutex(nil, true, sMutex);

  { 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;

initialization
  try
    Registrar;
  except
    Activar;
    Halt;
  end;

finalization
  if Mutex <> 0 then ReleaseMutex(Mutex);
end.

Funciona de perillas en Delphi XE2 y Windows 7. Gracias Román.

[roman]

Supongo que, desde el 2003, ya se ha ejecutado más de dos veces su programa Pero se agradece el comentario.

Ya en serio, tenía idea que, al menos con Delphi 2010, esa unidad ya no funcionaba.

// Saludos

[dec]

Ahí se ve, entre otras cosas, lo bueno de Delphi y algunos programadores...

[roman]

Hombre, ¿y el programador? En algo habrá contribuido ¿no?. Je, je, es pura broma.

// Saludos