No consigo impedir doble instancia del programa

[dabas]

He estado mirando los trucos y por los foros y no dando mil vueltas y no consigo evitar que se ejecute el programa mas de una vez.

Trabajo sobre windows 2000 y Delphi 7, no se si causa problemas con algunas funciones.

La funcion FindWindowEx siempre encuentra el programa pero no se me ocurre nada para que no se abra por segunda vez.

¿Alguna idea?

Us saludo a todos.

[Ruben_Cu]

Hola dabas, revisa el truco 162 de trucomania, yo tengo implementada la primera variante y me funciona bien evitando la doble ejecución.
Saludos y suerte

[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

[delphi.com.ar]

Otra solución, puede ser crear semáforos (CreateSemaphore)... y preguntar al iniciar la aplicación si existe ese semáforo, si existe puedes hacer algo parecido a lo que hace Román. En particular utilizo este método en aplicaciones que no usan la unit Forms.

Saludos!

[dabas]

Perfecto, no se que haria sin vosotros.

Esto es lo que he usado (Trucomania):

Añade 'TLHelp32' en el uses de tu form.
Añade esta función en el implementation de la form:

 function ProgramaAbiertoDosVeces:Boolean;
 var
   Datos          :TProcessEntry32; {Estructura interna de datos de un proceso}
   hID            : DWord;           {identificador del proceso}
   Snap           :Integer;
   NombreArchivo  :String;    {path del archivo original}
   Repetido       :Boolean;   {true si el programa se ha abierto dos veces}
   Handle1        :Hwnd;      {thandle}
   Contador       :Integer;   {Contador de aperturas}

 begin
   Contador:=0;
   NombreArchivo:=Application.Exename;
   Repetido:=False;
   GetWindowThreadProcessId(Handle1,@hID);
   Snap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
   try
     Datos.dwSize:=SizeOf(Datos);
     if(Process32First(Snap,Datos))then
     begin
       repeat
         if NombreArchivo=StrPas(Datos.szExeFile) then
         begin
            Inc(contador);
            if Contador>=2 then Repetido:=true;
         end;
       until (not(Process32Next(Snap,Datos))) or (Repetido);
     end;
   finally
     Windows.CloseHandle(Snap);
   end;
   Result:=Repetido;
 end;

Nota: lo malo que "Application.Exename" a mi me devuelve la ruta completa. Lo cambié por el nombre de mi programa.
Ahora, pon este código en el evento OnCreate de la form principal:

 procedure TForm1.FormCreate(Sender: TObject);
 begin
   if ProgramaAbiertoDosVeces then
   begin
    showmessage('El programa ha sido abierto mas de una vez');
    Application.terminate;
   end;
 end;

Ahi queda eso. Hasta otra foroadictos

[delphi.com.ar]

Te recomendaría probarlo en plataformas con arquitectura NT, pues no estoy del todo seguro que eso funcione.

Saludos!

[dabas]

Pues lo he probado en Windows 200 prof. y Windows XP prof. y funciona perfectamente.
Lee correctamente las procesos que se estan ejecutando

[dabas]

Pues sí roman, tu uiapp.pas tambien es perfecto, ni siquiera llega a abrirse el pograma.

Gracias por vuestras respuestas,

[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