Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #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: 181
Poder: 12
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
  #2  
Antiguo 22-06-2010
BrunoBsso BrunoBsso is offline
Miembro
 
Registrado: nov 2009
Ubicación: Berisso, Buenos Aires, Argentina
Posts: 239
Poder: 9
BrunoBsso Va por buen camino
Muy útil, me vino bárbaro.
Justo lo que necesitaba. También necesitaba, en otra aplicación, no el hecho de restaurar las instancias previas, sino simplemente evitar las nuevas. Pero tocando un poquito se logró.
Buen aporte!
Responder Con Cita
  #3  
Antiguo 04-02-2011
mantraxer21 mantraxer21 is offline
Miembro
 
Registrado: ago 2010
Posts: 94
Poder: 8
mantraxer21 Va por buen camino
Muy util, excelente
Responder Con Cita
  #4  
Antiguo 26-04-2011
Avatar de ramflores
ramflores ramflores is offline
Miembro
 
Registrado: may 2005
Ubicación: Monterrey, Mex.
Posts: 87
Poder: 13
ramflores Va por buen camino
Gracias, excelente solución, me ha servido de mucho
Responder Con Cita
  #5  
Antiguo 08-08-2011
Avatar de casacham
casacham casacham is offline
Miembro
 
Registrado: abr 2006
Ubicación: Cordoba->Argentina. Arboleas->Almeria->España
Posts: 181
Poder: 12
casacham Va por buen camino
Realmente me alegra poder hacer aportes a otros desarrolladores, muchas gracias por sus comentarios
Responder Con Cita
  #6  
Antiguo 20-10-2012
Avatar de radenf
radenf radenf is offline
Miembro
 
Registrado: oct 2007
Ubicación: Viña del Mar,Chile
Posts: 608
Poder: 11
radenf Va por buen camino
Excelente aporte casacham
Se agradece enormemente
Responder Con Cita
  #7  
Antiguo 25-10-2012
Avatar de rretamar
[rretamar] rretamar is offline
Miembro Premium
 
Registrado: ago 2006
Ubicación: San Francisco, Córdoba, Argentina
Posts: 1.104
Poder: 13
rretamar Va camino a la fama
Existe un componente para Lazarus llamado Uniqueinstance que hace lo mismo. Lo interesante de este componente es que funciona tanto en Windows como en Linux. Aquí se explica cómo instalarlo y usarlo:

http://wiki.freepascal.org/UniqueInstance/es

Este componente ya viene preinstalado en la distribución Lazarus Codetyphon.
__________________
Lazarus Codetyphon : Desarrollo de aplicaciones Object Pascal, libre y multiplataforma.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 06:33:52.


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