COMPOSANT RUNONCE: AUTORISER UN SEUL LANCEMENT D'UNE APPLICATION (OU NON!)

{ Code-source du programme }

program Project1;

uses
  Forms,
  RunOnce,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  { Il faut ABSOLUMENT que la fonction TestRunOnce soit appelée avant la création du composant TRunOnce. Sinon, une exception est déclenchée.
    Son résultat permet de savoir si on est la première instance lancée, ou si la première instance a autorisé le lancement }
  if not TestRunOnce('TestRunOnce') then
    Exit;

  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.




{ Code-source de la fiche principale (celle qui crée le composant) }

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RunOnce;

type
  TForm1 = class(TForm)
    procedure RunOnce1BlockInstance(Sender: TObject; Params: TStrings;
      var Allow: Boolean);
    procedure RunOnce1AcquireLock(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  public
    RunOnce1: TRunOnce;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.RunOnce1BlockInstance(Sender: TObject; Params: TStrings;
  var Allow: Boolean);
begin
  { événement appelé lors du lancement d'une 2ème instance du programme. On pose la question à l'utilisateur pour autoriser 
    ou non le 2ème lancement. Params contient la ligne de commande qui a servi à lancer cette 2ème instance }
  if MessageBox(0,
                PChar('Voulez vous autoriser le 2ème lancement de "'+Params[0]+'" ?'),
                'Confirmation',
                MB_YESNO or MB_ICONQUESTION or MB_SYSTEMMODAL)=ID_YES then
    Allow:=True;
end;

procedure TForm1.RunOnce1AcquireLock(Sender: TObject);
begin
  { événement appelé lorsque l'instance en cours devient celle qui décide si d'autres ont le droit de se lancer ou non.
    Ce cas peut se produire si une ou plusieurs instances ont été autorisées, et si la première instance
    (celle qui les a autorisées) a été fermée avant les autres. }
  Caption:='INSTANCE MAITRE';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { Le composant est créé à l'exécution pour ne pas être obligé d'installer le package pour compiler l'exemple }
  RunOnce1:=TRunOnce.Create(Self);
  RunOnce1.OnBlockInstance:=RunOnce1BlockInstance;
  RunOnce1.OnAcquireLock:=RunOnce1AcquireLock;
  if RunOnce1.IsMaster then
    Caption:='INSTANCE MAITRE';
end;

end.

Télécharger le zip

05 octobre 2006 17:46:47 :

Typo

05 octobre 2006 17:49:04 :

typo2

05 octobre 2006 22:17:19 :

Zip