Accueil > Codes Sources > Code du Jour

Instance d'Application Unique avec MUTEX

  Télécharger

 

Contrôler le nombre d'instance d'exécution d'une application en utilisant la création d'un Mutex.

Project1.dpr

program
Project1;

uses
Forms,
Dialogs,
windows,
Unit1 in 'Unit1.pas' {FMain};

{$R *.RES}

begin
SetLastError(NO_ERROR);
CreateMutex(nil,False,'OIM');
if GetLastError<>ERROR_ALREADY_EXISTS then
begin
Application.Initialize;
Application.Title := 'OneInstance APP';
Application.CreateForm(TFMain,FMain);
Application.Run;
end else ShowMEssage('Application Already Running !');
end.

Haut de Page ^

Unit1.pas

unit
Unit1;

interface

uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,ShellApi;

type
TFMain=class(TForm)
LbLink:TLabel;
Label1: TLabel;

procedure LbLinkClick(Sender:TObject);

private

public
end;

var
FMain:TFMain;

implementation

{$R *.DFM}

procedure TFMain.LbLinkClick(Sender:TObject);
begin
ShellExecute(Handle,'open',PChar(LbLink.Caption),nil,nil,1);
end;
end.

Haut de Page ^

Unit1.dfm

object FMain: TFMain
Left = 339
Top = 223
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'OneInstance Using Mutex'
ClientHeight = 177
ClientWidth = 324
Color = 13619151
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 16
object LbLink: TLabel
Left = 0
Top = 0
Width = 324
Height = 25
Cursor = crHandPoint
Align = alTop
Alignment = taCenter
AutoSize = False
Caption = 'http://www.delphilab.com'
Color = 9922099
Font.Charset = ANSI_CHARSET
Font.Color = clWhite
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = []
ParentColor = False
ParentFont = False
Layout = tlCenter
OnClick = LbLinkClick
end
object Label1: TLabel
Left = 8
Top = 40
Width = 260
Height = 16
Caption = 'Essayez d''exécuter deux fois cette application'
end
end

Haut de Page ^