[FONT=verdana, geneva, lucida, 'lucida grande', arial, helvetica, sans-serif]unit UIApp;
interface
implementation
uses
Windows, SysUtils, Forms;
const
{ Cadenas para registrar el mutex y el mensaje }
sMutex = 'F55F3FEC-94CC-4A02-8B31-5BF0EBE9E9EA';
sActivar = 'D8A807D2-D4DC-4102-B431-9CCD3636FFAB';
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
//Esta parte la pongo como dice en la pagina, y todo bien pero no me evita //las multiples instancias
if not IsWindowVisible(Handle) then
ShowWindow(Handle, SW_SHOW);
{ 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
//En la Pagina de Roman dice que cambiemoso esta parte por algo algo asi
//mActivar := RegisterWindowMessage(PChar(sActivar + //Application.ExeName));
//Mutex := CreateMutex(nil, true, PChar(sMutex + Application.ExeName));
//pero mi problema viene siento que si hago esto me abre las sesiones de //todos modos
}
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.