Ver Mensaje Individual
  #1  
Antiguo 06-04-2009
Avatar de casacham
casacham casacham is offline
Miembro
 
Registrado: abr 2006
Ubicación: Cordoba->Argentina. Arboleas->Almeria->España
Posts: 184
Reputación: 18
casacham Va por buen camino
Evitar multiples instancias de nuestra aplicacion

Este truco lo encontre navegando por internet y fue uno de esos descubribientos al azar con los que a veces uno se topa. El objetivo del siguiente codigo es evitar que nuestro programa sea abierto mas de una vez en el ordenador. Es decir evitar multiples instancias de nuestro programa.

Primero creen una nueva Unit y coloquen el siguiente codigo dentro de ella
Código Delphi [-]
unit CheckPrevious;

interface
uses Windows, SysUtils;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;

implementation

type
  PInstanceInfo = ^TInstanceInfo;
  TInstanceInfo = packed record
    PreviousHandle : THandle;
    RunCounter : integer;
  end;

var
  MappingHandle: THandle;
  InstanceInfo: PInstanceInfo;
  MappingName : string;

  RemoveMe : boolean = True;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;
begin
  Result := True;

  MappingName :=StringReplace(ParamStr(0),'\','',[rfReplaceAll, rfIgnoreCase]);

  MappingHandle := CreateFileMapping($FFFFFFFF,
                                     nil,
                                     PAGE_READWRITE,
                                     0,
                                     SizeOf(TInstanceInfo),
                                     PChar(MappingName));

  if MappingHandle = 0 then
    RaiseLastOSError
  else
  begin
    if GetLastError <> ERROR_ALREADY_EXISTS then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle,
                                    FILE_MAP_ALL_ACCESS,
                                    0,
                                    0,
                                    SizeOf(TInstanceInfo));

      InstanceInfo^.PreviousHandle := AppHandle;
      InstanceInfo^.RunCounter := 1;

      Result := False;
    end
    else //already runing
    begin
      MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
      if MappingHandle <> 0 then
      begin
        InstanceInfo := MapViewOfFile(MappingHandle,
                                      FILE_MAP_ALL_ACCESS,
                                      0,
                                      0,
                                      SizeOf(TInstanceInfo));

        if InstanceInfo^.RunCounter >= MaxInstances then
        begin
          RemoveMe := False;

          if IsIconic(InstanceInfo^.PreviousHandle) then
            ShowWindow(InstanceInfo^.PreviousHandle, SW_RESTORE);
          SetForegroundWindow(InstanceInfo^.PreviousHandle);
        end
        else
        begin
          InstanceInfo^.PreviousHandle := AppHandle;
          InstanceInfo^.RunCounter := 1 + InstanceInfo^.RunCounter;

          Result := False;
        end
      end;
    end;

  end;
end;

initialization

finalization
  //remove one instance
  if RemoveMe then
  begin
    MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
    if MappingHandle <> 0 then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle,
                                  FILE_MAP_ALL_ACCESS,
                                  0,
                                  0,
                                  SizeOf(TInstanceInfo));

      InstanceInfo^.RunCounter := -1 + InstanceInfo^.RunCounter;
    end
    else
      RaiseLastOSError;
  end;

  if Assigned(InstanceInfo) then UnmapViewOfFile(InstanceInfo);
  if MappingHandle <> 0 then CloseHandle(MappingHandle);

end.

Segundo salven la unit con el nombre CheckPrevious

Tercero ahora deben incluirla en cualquiera de sus proyectos y hacer un agregado al codigo en el archivo de proyecto de su aplicacion como se ve aqui abajo. Recuerde que para agregar esta unit a su proyecto recomiendo copiar su archivo a la misma carpeta en la que esta su aplicacion en desarrollo y luego agregarla con Add file to proyect pulsando en delphi 2007 SHIFT+F11

Código Delphi [-]
program Obessologia08;

uses
  
  Forms,
  Controls,
  Windows,
  U_Prin                         in 'U_Prin.pas' {F_Prin},
  U_DM_Obess                     in 'U_DM_Obess.pas' {DM_Obess: TDataModule},
  FuncionesGlobales              in 'FuncionesGlobales.pas',
...
....
...
...
...
....

  U_AutoresVersion               in 'U_AutoresVersion.pas' {F_AutoresVersion},
  U_Producto                     in 'U_Producto.pas' {FProducto},
  U_Claves                       in 'U_Claves.pas' {FClaves},
  CheckPrevious                  in 'CheckPrevious.pas';

{$R *.res}
Var R: Integer;

begin
// Aqui va el agregado de la linea de CheckPrevious
 if not CheckPrevious.RestoreIfRunning(Application.Handle, 1) then begin
  Application.Initialize;
  Application.Title := 'Cirugía Metabólica DataSet';
  Application.MainFormOnTaskbar := True;
  try
    F_Login:=TF_Login.Create(Application);
    R      :=F_Login.ShowModal;
    F_Login.Free;
    if R = mrOK then begin
       Application.CreateForm(TDM_Obess, DM_Obess);
  Application.CreateForm(TF_Prin, F_Prin);
  Application.Run;
    end;
    if R = mrAbort then begin
       FNoAdmitido:=TFNoAdmitido.Create(Application);
       FNoAdmitido.ShowModal;
       FNoAdmitido.Free;
       F_AutoresVersion:=TF_AutoresVersion.Create(Application);
       F_AutoresVersion.ShowModal;
       F_AutoresVersion.Free;
       Application.Terminate;
    end;
  finally
    Application.Terminate;
  end;
 end;
end.

Otro ejemplo de su uso

Código Delphi [-]
program Mailing;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  VCLFixPack in 'VCLFixPack.pas',
  CheckPrevious in 'CheckPrevious.pas',
  ThreadSendMailer in 'ThreadSendMailer.pas';

{$R *.res}

begin
if not CheckPrevious.RestoreIfRunning(Application.Handle, 1) then
  begin
      Application.Initialize;
      Application.MainFormOnTaskbar := True;
      Application.Title := 'Enviar correos por smtp';
      Application.CreateForm(TForm1, Form1);
  Application.Run;
  end;
end.
Responder Con Cita