Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   como cerrar la instancia anterior (https://www.clubdelphi.com/foros/showthread.php?t=62931)

The_Duke 21-01-2009 17:16:42

como cerrar la instancia anterior
 
Saludo, estoy haciendo un visor de imágenes, y e asociado los tipos de archivo para que abran con la aplicación y quiero que si ya hay una instancia de mi aplicación presente y se abra otra imagen desde una carpeta la instancia anterior se cierre y quede solo a nueva instancia. E probado este código que encontré en el foro, pero sierra todos los procesos con el mismo nombre y trate de modificarlo pero no lo conseguí. Si conocen alguna mejor forma o pueden modificar este se lo agradecería.

Código Delphi [-]

procedure MatarProceso(FileName:String);
   var
       ContinueLoop:BOOL;
       FSnapshotHandle:THandle;
       FProcessEntry32:TProcessEntry32;
   const
       PROCESS_TERMINATE=$0001;
   begin
       FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
       FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
       ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);
       while integer(ContinueLoop)<>0 do
       begin
           if FProcessEntry32.szExeFile=FileName then
             TerminateProcess( OpenProcess(PROCESS_TERMINATE,BOOL(0),
                               FProcessEntry32.th32ProcessID),0);
             ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
       end;
       CloseHandle(FSnapshotHandle);
   end;

dec 21-01-2009 17:18:56

Hola,

Echa un vistazo a este estupendo documento. ;)

The_Duke 21-01-2009 22:17:26

Gracias por la ayuda Dec, e modificado el codigo para lo que necesito.
y aqui lo dejo para os que os puedan necesitar, y si hacen alguna mejora, ya que encuentro que es ago ento no mucho pero se nota.

Código Delphi [-]
unit UIApp;

interface

implementation

uses
  Windows, SysUtils, Forms, Dialogs, Messages, Unit1;

const
  { Cadenas para registrar el mutex y el mensaje }
  sMutex   = '10D73234-C9F7-4C2D-BC7E-39B5820AF456';
  sActivar = '3F154732-CCDE-4BC7-9439-AFCD3BCFA84D';

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

    Form1.close;

  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
        Activar;
        PrevWndProc := TFarProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
  SetWindowLong(Application.Handle, GWL_WNDPROC, LongWord(@AppWndProc));
  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
    Halt;
  end;

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


La franja horaria es GMT +2. Ahora son las 04:37:49.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi