[RESUELTO] Como evitar que mi aplicacion se abra 2 veces en la misma pc
#1
Escrito 17 enero 2011 - 07:17
La verdad que he encontrado muchos truquitos sobre este asunto, pero me encantaria leer las opiniones de los miembros del foro. La idea es evitar que mi aplicacion se abra dos veces y que si ya esta abierta se restaure.
Gracias por adelantado
#2
Escrito 17 enero 2011 - 07:31
Prevenir dos ejecuciones simultaneas de tu aplicación
(Q3 Team)
Esto sirve para que no ejecuten tu programa más de una vez simultaneamente. Puede que quieras simplemente denegar la creación de la segunda instancia de tu aplicación, o puede que lo que quieras es que no sólo no se abra la segunda instancia, sino que se restaure la primera (que igual está minimizada, por ejemplo).
Hay muchas maneras de hacer esto. En este truco he querido poner una que me ha llamado la atención por su sencillez. En Delphi 1 el detectar una instancia anterior era tan fácil como chequear la variable hPrevinst, pero en Delphi 32 bits esta variable ya no existe, así que tenemos que buscar otra manera de detectar otra copia de nuestra aplicación.
Aqui la buscaremos con ayuda de FindWindow y un pequeño truco para simplificar la búsqueda:
Meteremos este código en el código del proyecto, para lo cual has de habilitar la pestaña de ver código del proyecto, que está en: View->Project Source
program Project1; uses Forms, Windows, Messages, Unit1 in 'Unit1.pas' {Form1}; const CM_RESTORE = WM_USER + $1000; var RvHandle : hWnd; {$R *.RES} begin {Si existe otra instancia ya ejecutandose, la activamos} RvHandle := FindWindow('Mi programa Delphi', NIL); if RvHandle > 0 then begin PostMessage(RvHandle, CM_RESTORE, 0, 0); Exit; end; {Sino, haz lo normal} Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.
En la declaración de la form, añadiremos este código, (la constante y las dos procedures que hay en la parte public)
const CM_RESTORE = WM_USER + $1000; type TForm1 = class(TForm) Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } procedure CreateParams(var Params: TCreateParams); override; Procedure RestoreRequest(var message: TMessage); message CM_RESTORE; end;
Y en la implementation de la form, pondremos el código de las dos procedures que hemos definido:
procedure TForm1.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.WinClassName := 'Mi programa Delphi'; end; procedure TForm1.RestoreRequest(var message: TMessage); begin if IsIconic(Application.Handle) = TRUE then Application.Restore else Application.BringToFront; end;
#3
Escrito 18 enero 2011 - 07:06
(Un pequeñito detalle, mejor definir esa cadena "Mi programa Delphi" como una constante, en el form principal por ejemplo, para evitar duplicidades )
Saludos
PD: Por cierto, al leer este hilo, me he ido a buscar un componente que creó Román, de ClubDelphi, que servía para este propósito, pero su página personal ya no está operativa
#4
Escrito 18 enero 2011 - 07:53
CreateMutex(nil, False, 'MyAppId'); if GetLastError <> 0 then Exit; // Halt; // SendMessage(FindWindow(
#5
Escrito 18 enero 2011 - 08:23
Si el proposito es solo "evitar" yo uso lo siguiente;
delphi
CreateMutex(nil, False, 'MyAppId'); if GetLastError <> 0 then Exit; // Halt; // SendMessage(FindWindow(
, caramba amigo, tu siempre tan corto de escritura
Salud OS
#6
Escrito 18 enero 2011 - 08:59
#7
Escrito 18 enero 2011 - 09:02
Donde se supone que debo poner el codigo de cHackAll?
Pues yo lo pondría en el .dpr
Salud OS
#8
Escrito 19 enero 2011 - 07:27
program Project1; uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} begin CreateMutex(nil, False, 'MyAppId'); if GetLastError <> 0 then Exit; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.
ó
unit Unit1; { etc, etc. } var Form1: TForm1; implementation {$R *.dfm} initialization CreateMutex(nil, False, 'MyAppId'); if GetLastError <> 0 then Halt; end.
ó
procedure TForm1.FormCreate(Sender: TObject); begin CreateMutex(nil, False, 'MyAppId'); if GetLastError <> 0 then Halt; end;
un ejemplo;
unit Unit1; interface uses Windows, Messages, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure User(var Msg: TMessage); message WM_USER; end; var Form1: TForm1; implementation {$r *.dfm} procedure TForm1.FormCreate(Sender: TObject); var Str: ShortString; begin Str := ClassName; CreateMutex(nil, False, PChar(Str + '.' + Caption)); if GetLastError = 0 then Exit; DestroyWnd; Str[Byte(Str[0]) + 1] := #0; PostMessage(FindWindow(@Str[1], PChar(Caption)), WM_USER, 0, 0); Halt; end; var Info: TFlashWInfo = (cbSize: SizeOf(Info); dwFlags: FLASHW_ALL or FLASHW_TIMERNOFG); procedure TForm1.User(var Msg: TMessage); begin Info.hwnd := Application.Handle; FlashWindowEx(Info); end; end.
#9
Escrito 22 enero 2011 - 07:08
en el uses adicionar: dialogs
begin CreateMutex(nil, False, 'MyAppId'); if GetLastError <> 0 then begin showmessage('la aplicacion ya esta corriendo'); Exit; end; Application.Initialize; Application.CreateForm(TDMmonitorenred, DMmonitorenred); Application.CreateForm(TFRMactivasred, FRMactivasred); Application.CreateForm(TFRMoperadornota, FRMoperadornota); Application.Run; end.
#10
Escrito 30 enero 2011 - 07:06
WinExec(PChar('c:\COBROS\PCOBROS.exe'),SW_SHOWNORMAL)
pero cada vez que le doy al boton, si le he puesto el codigo:
program PCOBROS; uses Forms,Windows,Dialogs,Controls, UFRMCOBROS in 'UFRMCOBROS.pas' {Form1}, UDMCOBROS in 'UDMCOBROS.pas' {DMCOBROS: TDataModule}; {$R *.res} begin CreateMutex(nil, False, 'MyAppId'); if GetLastError <> 0 then begin showmessage('la aplicacion ya esta abierta'); Exit; end; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.CreateForm(TDMCOBROS, DMCOBROS); Application.Run; end.
me envia el mensaje de que esta abierto, desde la primera vez que le doy.
Que esta pasando?
#11
Escrito 30 enero 2011 - 08:19
program PCOBROS; :::::::: CreateMutex(nil, False, 'PCOBROS'); ::::::::
Salud OS
Edito: Yo colocaría el nombre de la aplicación ya que si a todos los programas les asignara el mismo nombre ´MyAppId´ pudiese suceder lo que mencionas.
#12
Escrito 30 enero 2011 - 08:37
#13
Escrito 30 enero 2011 - 09:01
PD. Como se puede maximizar la aplicacion.
#14
Escrito 30 enero 2011 - 10:45
Efectivamente Egostar, creo que la edad ya me esta haciendo mal. Pero para eso estan ustedes los mas viejos que me sirven de consuelo
PD. Como se puede maximizar la aplicacion.
No importa amigo Luciano, lo mejor de llegar a viejo es que todos los dias vas a conocer amigos nuevos
Salud OS
#15
Escrito 31 enero 2011 - 05:34
El código se coloca en el archivo .dpr que quedaría como sigue:
program Project1; uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} var Buffer: array [0..MAX_PATH] of char; c: PCHAR; Mutex: THandle; Pid: DWORD; function EnumWindowsProc(Handle: Thandle; lParam: LPARAM): BOOL; stdcall; var Mutex: THandle; begin Result:= true; GetWindowThreadProcessId(Handle, Pid); if GetCurrentProcessId <> Pid then begin if GetWindowModuleFileName(Handle, @Buffer, sizeof(Buffer)) > 0 then begin c:= Buffer; repeat Inc(c); if c^ = '\' then c^:= '*'; until c^ = #0; Mutex:= CreateMutex(nil, FALSE, Buffer); GetClassName(Handle, Buffer, Sizeof(Buffer)); if (GetLastError <> 0) and (lstrcmp('TApplication', Buffer) = 0) then begin ShowWindow(Handle, SW_RESTORE); SetForegroundWindow(Handle); end; if Mutex <> 0 then CloseHandle(Mutex); end; end; end; begin GetModuleFileName(0, Buffer, MAX_PATH); c:= Buffer; repeat Inc(c); if c^ = '\' then c^:= '*'; until c^ = #0; Mutex:= CreateMutex(nil, FALSE, Buffer); if GetLastError <> 0 then begin EnumWindows(@EnumWindowsProc, 0); exit; end; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; if Mutex <> 0 then CloseHandle(Mutex); end.
Saludos.
#16
Escrito 31 enero 2011 - 07:46
Gracias por el codigo Escafandra, pero al tratar de arrancar el programa, me sale este error:
program Pmonitoreofirebird; uses Windows, Dialogs, Forms, controls, frmmonitoreoenred in 'frmmonitoreoenred.pas' {FRMactivasred}, UDMmonitorenred in 'UDMmonitorenred.pas' {DMmonitorenred: TDataModule}, UFRMNOTAS in 'UFRMNOTAS.pas' {FRMnotas}, UFRQcentral in 'UFRQcentral.pas' {FRQcentral}, Ufrmlogin in 'Ufrmlogin.pas' {FRMlogin}, UFRMSONIDO in 'UFRMSONIDO.pas' {SONIDO}, _busy in '_busy.pas', FRMcierreproceso in 'FRMcierreproceso.pas' {FRMCIERRE}, Ufrmreconexion in 'Ufrmreconexion.pas' {FRMreconexion}, frmllamada in 'frmllamada.pas' {FRMLLAMADAS}, UFRMusuarios in 'UFRMusuarios.pas' {FRMusuarios}, FRPinformes in 'FRPinformes.pas' {FRMINFORME}, UFRMclientes in 'UFRMclientes.pas' {FRMclientes}, Ufrmoperadornota in 'Ufrmoperadornota.pas' {FRMoperadornota}; {$R *.res} var Buffer: array [0..MAX_PATH] of char; c: PCHAR; Mutex: THandle; Pid: DWORD; function EnumWindowsProc(Handle: Thandle; lParam: LPARAM): BOOL; stdcall; var Mutex: THandle; begin Result:= true; GetWindowThreadProcessId(Handle, Pid); if GetCurrentProcessId <> Pid then begin if GetWindowModuleFileName(Handle, @Buffer, sizeof(Buffer)) > 0 then begin c:= Buffer; repeat Inc(c); if c^ = '' then c^:= '*'; until c^ = #0; Mutex:= CreateMutex(nil, FALSE, Buffer); GetClassName(Handle, Buffer, Sizeof(Buffer)); if (GetLastError <> 0) and (lstrcmp('TApplication', Buffer) = 0) then begin ShowWindow(Handle, SW_RESTORE); SetForegroundWindow(Handle); end; if Mutex <> 0 then CloseHandle(Mutex); end; end; end; begin GetModuleFileName(0, Buffer, MAX_PATH); c:= Buffer; repeat Inc(c); if c^ = '' then c^:= '*'; until c^ = #0; Mutex:= CreateMutex(nil, FALSE, Buffer); if GetLastError <> 0 then begin EnumWindows(@EnumWindowsProc, 0); exit; end; {begin CreateMutex(nil, False, 'Pmonitoreofirebird'); if GetLastError <> 0 then begin showmessage('la aplicacion ya esta abierta, revise si esta minimizada'); Exit; end; } Application.Initialize; Application.CreateForm(TDMmonitorenred, DMmonitorenred); Application.CreateForm(TFRMactivasred, FRMactivasred); Application.Run; if Mutex <> 0 then CloseHandle(Mutex); end.
cual puede ser el problema?, La unica diferencia que veo es que yo creo el datamodule primero y luego el form principal.
#17
Escrito 01 febrero 2011 - 03:24
Hemos sido víctimas de un gremlin. Parece ser que algo impide y retita los caracteres '\' del código publicado, como hize notar aquí. Al publicar el código no advertí que se habián elimidado dichos caracteres de las líneas como esta:
repeat Inc(c); if c^ = '' then c^:= '*'; until c^ = #0;
que debían quedar así:
repeat Inc(c); if c^ = '\' then c^:= '*'; until c^ = #0;
Este es el origen del error que has mostrado.
He reeditado el código del mensaje.
Por si acaso el gremlin ataca de nuevo, subo un archivo de ejemplo.
Saludos.
#18
Escrito 01 febrero 2011 - 12:28
#19
Escrito 01 febrero 2011 - 12:50
Pues yo lo he notado con Chrome y FireFox, tiene que ver con pegar texto con el caracter '\'. Al parecer puede ser problema del foro y se está estudiando una actualización.¿Y qué sabéis del gremlin? A mí me paso hace unas semanas en un mensaje cada vez que lo editaba, me dí cuenta de que todas las barras '\' me habían desaparecido
Al citar tu mensaje me ha borrado el carácter en cuestión y he tenido que reconstituirlo. Ahora estoy usando Chrome.
Saludos.
#20
Escrito 01 febrero 2011 - 01:35
Saludos,