La Web del Programador: Comunidad de Programadores
 
https://www.lawebdelprogramador.com/preguntas/

    Pregunta:  39916 - COMO SABER SI UNA APLICACION YA ESTA ABIERTA CON DELPHI
Autor:  David Silva
Hola.

Mi pregunta se refiere para saber si una aplicación ya se encuentra abierta, esto es para que no puedan abrir dos veces una aplicación que esta desarrollada con Delphi 6.
  Respuesta:  Reynaldo Tellez Menocal
Este truco lo saque del trucomania para Delphi, en la grupo aplicacion pruebalo a ver si te sirve, a mi me dio resultado.

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 projecto, 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}
{If there's another instance already running, activate that one}
RvHandle := FindWindow('Mi programa Delphi', NIL);
if RvHandle > 0 then
begin
PostMessage(RvHandle, CM_RESTORE, 0, 0);
Exit;
end;

{Sino, haz lo normal}
{Else, do the normal stuff}
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;

El funcionamiento de todo esto es el siguiente:
-Definimos un nuevo CreateParams para nuestra form, que lo que hace es asignar 'Mi programa Delphi' al WinClassName para luego poder buscar nuestra aplicación con mayor facilidad mediante FindWindow
-Creamos una procedure de tratamiento de nuestro mensaje: CM_RESTORE, que servirá para decirle a la primera instancia de nuestra aplicación que queremos que 'resucite'
-Y por ultimo, en el fuente del proyecto, buscamos una instancia previa de nuestra aplicación mediante FindWindow, y, si la encontramos, la enviamos nuestro propio mensaje CM_RESTORE para que resucite.

Otro ejemplo, mediante un semáforo

Pon esto en el OnCreate de tu form:

procedure TMainForm.FormCreate(Sender: TObject);
var Sem : THandle;
begin
Sem := CreateSemaphore(nil,0,1,'PROGRAM_NAME');
if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
begin
CloseHandle( Sem );
ShowMessage('This program is already running.'+
'Este programa ya se está ejecutando...');
Halt;
end;
end;

Otro ejemplo, mediante la unit TLHelp32 y el nombre del ejecutable

(Enviado por Javier Pareja ([email protected]))

Simplemente detectaremos si hay otro ejecutable ejecutándose que se llame igual que el nuestro.

-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;

-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;

Otro ejemplo, mediante Mutex

Enviado por: Juan Manuel Ospina C. ([email protected])

procedure Tform1.FormCreate(Sender: TObject);
begin
CreateMutex(nil, false, 'miprog1');
if GetLastError = ERROR_ALREADY_EXISTS then
halt(0);
........
........

Se trata de crear un mutex, y si a la hora de crearlo ya existe... pues sale de la aplicacion con Halt

Lo del Mutex, mejor explicado..

Enviado por: Xavier Martínez ([email protected])

mutex.dpr
program YoQueSe;
uses Forms,
Windows,
Dialogs,
form1 in 'form1.pas';
{$R *.RES}
const NombreMutex='Programa 1.2';
var MiMutex:Thandle;
begin
mimutex:= CreateMutex(nil,true,NombreMutex);
if MiMutex=0 then
begin
Showmessage('Error creando mutex');
halt;
end;
if GetLastError=ERROR_ALREADY_EXISTS then
begin
Showmessage('Programa ya está funcionando');
halt;
end;
Application.initialize;
......createform (bueno, ya sabes)
......run
CloseHandle(MiMutex);
end.