1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
| unit USingleInst;
interface
uses Windows,SysUtils,Classes;
type
TSingleInst=class(TComponent)
public
constructor Create(AOwner:TComponent);override;
destructor Destroy();override;
end;
procedure Register;
implementation
var
PrvInst :TSingleInst =nil;
MutHandle :THandle;
procedure Register;
begin
RegisterComponents('Exemples', [TSingleInst]);
end;
procedure IniInstance();
var
Erreur: Integer;
Mut :string;
begin
Mut := StringReplace(ParamStr(0),'\','',[rfReplaceAll]);
SetLastError(NO_ERROR);
MutHandle :=CreateMutex(nil, False,PChar(Mut));
Erreur := GetLastError;
if (Erreur = ERROR_ALREADY_EXISTS ) or ( Erreur = ERROR_ACCESS_DENIED ) then
begin
MutHandle := 0;
Halt;
end;
end;
{ TSingleInst }
constructor TSingleInst.Create(AOwner: TComponent);
begin
if PrvInst = nil then
PrvInst := inherited Create(AOwner)
else
raise Exception.Create('Only one inctance of TSingleInst can be used');
end;
destructor TSingleInst.Destroy;
begin
if PrvInst = Self then
PrvInst := nil;
inherited;
end;
initialization
IniInstance();
finalization
if MutHandle <> 0 then
CloseHandle(MutHandle);
end. |
Partager