Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   No consigo impedir doble instancia del programa (https://www.clubdelphi.com/foros/showthread.php?t=3662)

dabas 16-09-2003 02:47:15

No consigo impedir doble instancia del programa
 
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 16-09-2003 03:57:57

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 16-09-2003 06:03:47

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 16-09-2003 16:23:38

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 17-09-2003 02:01:31

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:
Código:

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:
Código:

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 :p

delphi.com.ar 17-09-2003 15:49:52

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

Saludos!

dabas 20-09-2003 01:43:46

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

dabas 20-09-2003 21:56:07

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

Gracias por vuestras respuestas,

dec 30-08-2012 02:43:19

Cita:

Empezado por roman (Mensaje 14558)
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 30-08-2012 02:49:19

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

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

// Saludos

dec 30-08-2012 02:52:29

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

roman 30-08-2012 02:53:54

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

// Saludos


La franja horaria es GMT +2. Ahora son las 02:46:50.

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