Code:
{***********************************************************************}
{FileName : OneInstance.pas }
{Version* : 2.3 }
{Author(s) : Andrew Johnson <AJ_Genius@Hotmail.com> }
{ }
{License* LGPL }
{Copyright* 2000, 2001, 2002 Andrew Johnson }
{***********************************************************************}
{Comments : This File supplies TOneInstance, a component designed to }
{ determine if a former instance of a program is still running. By }
{ default if one is found then the current instance is terminated, }
{ though this behaviour can be changed by toggling the Terminate flag.}
{ Other proprties which can be set are InformUser, which informs the }
{ User that a former instance is still open; RaisePriorInstance which }
{ tries to bring the former instance to the front of the screen and }
{ give it the focus; and ApplicationExists, a Notify-Event to run a }
{ specified routine in the event that a prior instance is found. }
{ Under Linux there is also an unpublished(for DFM compatibility) }
{ property LockFileName, which sets the Lock file(but not dir) name. }
{***********************************************************************}
{Specifics: }
{ Windows: a unique Mutex is created by the component, if it cannot }
{ be created then a former instance is still open. To raise the former}
{ instance it attempts to find the Application handle using Windows }
{ FindWindow, and post SW_RESTORE and call BringToFront for the last }
{ active popup(GetLastActivePopup). }
{ }
{ Linux: a Lock File is created which contains the unique PID of the }
{ current instance, if the LockFile still exists and the PID can be }
{ posted-to (via Libc.sigqueue), then a former instance is still open.}
{ To raise the former instance it attempts to post SIGUSR1 to the PID }
{ of the former instance, which should be handled by SIGUSR1_Handle. }
{***********************************************************************}
{Problems : }
{ }
{ 1.) Not enough error handling }
{ 2.) Code's still a bit of a mess }
{ 3.) Minor Inconsitencies between Windows and Linux Code }
{ }
{ Windows Specific: }
{ 4.) Raising the former instance of an application requires }
{ that the Application Title be the same for both, and unique. }
{ }
{ Linux Specific: }
{ 5.) The lock file may not be read/write accesible if the }
{ program was opened by a different user, aka using SU/SUDO. }
{ 6.) Raising the former instance does not always work if the program }
{ has been manually minimized, aka Application.minimize. }
{ 7.) Sometimes when raising the former instance the form is focused }
{ but not brought to front, or the opposite(unfocused, infront). }
{***********************************************************************}
{*See end of file for history and Copyright/License information }
{***********************************************************************}
unit OneInstance;
interface
{$IfDef Linux}
uses
Libc, Sysutils, Classes, QForms, QDialogs;
{$Else}
{$IfNDef Windows}
{$Define Windows}
{$EndIf}
uses
Windows, Sysutils, Classes, Forms, Dialogs;
{$EndIf}
type
EOneInstance = Class(Exception);
TOneInstance = class(TComponent)
private
FTerminate: Boolean;
FApplicationExists: TNotifyEvent;
LockCreated: Boolean;
{$IfDef Linux}
FLockFileName : String;
Directory : String;
LockFile : String;
{$EndIf}
FInformUser,
FRestorePriorInstance : Boolean;
protected
{$IfDef Linux}
AppHandle: pid_t;
{$Else}
AppHandle: hWnd;
AppTitle : String;
{$EndIf}
{Error Handling}
Procedure RaiseException(theMessage : String);
Procedure HandleException(Info : String; theException : Exception);
{Creating/Deleting Unique LockFile/Mutex}
Procedure InitializeLock;
Procedure FinalizeLock;
{Handling Existance of Prior Instance}
Procedure DoRaisePriorInstance;
Function HasPriorInstance : Boolean;
public
procedure Loaded; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
{$IfDef Linux}
{Name of Unique LockFile to use}
property LockFileName : String read FLockFileName write FLockFileName;
{$EndIf}
published
{Terminate Current Instance on Discovery of Prior Instance}
property Terminate: Boolean read FTerminate write FTerminate default True;
{Inform User on Discovery of Prior Instance}
property InformUser : Boolean read FInformUser write FInformUser;
{Raise Prior Instance to Front if Found}
property RaisePriorInstance : Boolean read FRestorePriorInstance
write FRestorePriorInstance;
{Custom Procedure to Run on Discovery of Prior Instance}
property ApplicationExists: TNotifyEvent read FApplicationExists
write FApplicationExists;
end;
procedure Register;
implementation
{$R *.dcr}
{$IfDef Linux}
procedure SIGUSR1_Handle(SigNum: Integer); cdecl;
begin
Application.Restore;
Application.BringToFront;
end;
{$EndIf}
Procedure TOneInstance.RaiseException(theMessage : String);
begin
Try
Raise EOneInstance.Create(theMessage);
Except on E : Exception do
Application.HandleException(self);
end;
end;
Procedure TOneInstance.HandleException(Info : String;
theException : Exception);
begin
RaiseException(Info + ' An Exception was raised ' +
'with the message : ' + theException.Message);
end;
Procedure TOneInstance.InitializeLock;
{$IfDef Linux}
var
F : TextFile;
{$EndIf}
begin
{$IfDef Linux}
If FileExists(LockFile) then
DeleteFile(LockFile);
If not DirectoryExists(Directory) then
ForceDirectories(Directory);
FileClose(FileCreate(LockFile,DEFFILEMODE));
System.Assign(F,LockFile);
Rewrite(F);
Writeln(F,intToStr(getpid));
Close(F);
signal(SIGUSR1, SIGUSR1_Handle);
{$Else}
Try
AppHandle := CreateMutex(nil, False, PChar(ExtractFileName(
Application.ExeName)));
except on E : Exception do
HandleException('Unable to create Mutex!', E);
end;
{$EndIf}
end;
Procedure TOneInstance.FinalizeLock;
begin
{$IfDef Linux}
Try
If FileExists(LockFile) then
DeleteFile(LockFile);
except on E : Exception do
HandleException('Unable to delete lock file!', E);
end;
{$Else}
Try
CloseHandle(AppHandle)
except on E : Exception do
HandleException('Unable to close Mutex!',E);
end;
{$EndIf}
end;
Function TOneInstance.HasPriorInstance : Boolean;
{$IfDef Linux}
var
F : TextFile;
val : String;
sig : sigval;
{$EndIf}
begin
Result := True;//to be on the safe side, always assume the worst
{$IfDef Linux}
AppHandle := -1;
If FileExists(LockFile) then begin
Try
System.Assign(F,LockFile);
FileMode := 0;
Reset(F);
System.Readln(F,Val);
Close(F);
except on E : Exception do
begin
HandleException('Unable to read existing lock file!',E);
exit;
end;
end;
Try
If (sigqueue(StrToInt(Val),0,sig) = 0) or (Errno <> ESRCH) then
AppHandle := StrToInt(Val);
except on E : Exception do
begin
AppHandle := -1;
HandleException('Error verifying PID in lock file is ' +
'Valid!', E);
exit;
end;
end;
end;
If AppHandle > -1 then begin
//--> something needs to be added here eventualy to check and ensure that
//--> the AppHandle really is the same program. While the probablity of
//--> it not being the same is very, very, very slim, still.....
end;
Result := AppHandle <> -1;
{$Else}
Try
AppHandle := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(ExtractFileName(
Application.ExeName)));
except on E : Exception do
begin
HandleException('Unable to verify that Mutex already exists!',E);
exit;
end;
end;
Result := AppHandle > 0;
If result then
CloseHandle(AppHandle);
AppHandle := 0;
{$EndIf}
end;
Procedure TOneInstance.DoRaisePriorInstance;
var
{$IfDef Linux}
sig : sigval;
{$Else}
Handle,
Popup : THandle;
{$EndIf}
begin
If RaisePriorInstance then begin
{$IfDef Linux}
sigqueue(AppHandle,SIGUSR1,sig);
{$Else}
If AppTitle = '' then
exit;
Application.Title := '';
Handle := FindWindow(nil,PChar(AppTitle));
If Handle <> 0 Then Begin
Popup := GetLastActivePopup(Handle);
If IsIconic(Handle) Then
ShowWindow(Handle,SW_RESTORE);
BringWindowToTop(Handle);
If Popup <> 0 then begin
If IsIconic(Popup) Then
ShowWindow(Popup,SW_RESTORE);
BringWindowToTop(Popup);
SetForegroundWindow(Popup);
end;
end;
{$EndIf}
end;
end;
procedure TOneInstance.Loaded;
begin
inherited Loaded;
If csDesigning in ComponentState then
exit;
{$IfDef Windows}
AppTitle := Application.Title;
{$EndIf}
If not HasPriorInstance then begin
InitializeLock;
LockCreated := True;
end else begin
LockCreated := False;
If Assigned(FApplicationExists) then
FApplicationExists(Self);
If Terminate then begin
If InformUser then
RaiseException('Another instance of this application ' +
'appears to be running. You must ' + #13#10 + 'close any previous '
+ 'instances before continuing. '
{$IfDef Linux}
+ 'If no other instance is running '
+ #13#10 + 'try deleting the lock file. ' + #13#10#13#10 +
'LockFile : ' + LockFile + ''
{$EndIf});
Application.Terminate;
end
else
If InformUser then
MessageDlg('Another instance of this application ' +
'appears to be running!',mtWarning,[mbok],0);
end;
end;
constructor TOneInstance.Create(aOwner: TComponent);
var
I : integer;
begin
{$IfDef Linux}
Directory := '/tmp';
if euidaccess(PChar(Directory), R_OK or W_OK) = 0 then
Directory := Directory + '/kylixapps/'
else begin
Directory := '~';
if euidaccess(PChar(Directory), R_OK or W_OK) = 0 then
Directory := Directory + '/kylixapps/'
else
begin
RaiseException('Unable to read/write users home!');
Exit;
end;
end;
If LockFileName = '' then
LockFile := Directory +
ExtractFileName(Application.ExeName) + '.lock'
else
LockFile := Directory + LockFileName;
{$EndIf}
for I := 0 to AOwner.ComponentCount - 1 do
if AOwner.Components[I] is TOneInstance then
raise Exception.Create('OneInstance component duplicated in ' +
AOwner.Name);
inherited Create(aOwner);
FTerminate := True;
end;
destructor TOneInstance.Destroy;
begin
if LockCreated then
FinalizeLock
else
DoRaisePriorInstance;
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('Additional', [TOneInstance]);
end;
{$Warnings Off}
end.
{***********************************************************************}
{ Copyright/License Information }
{***********************************************************************}
{ This file falls under the LGPL, or the Library General Public }
{ License, aka the Lesser General Public License, thus: }
{ }
{ This file is distributed in the hope that it will be useful, }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. }
{ }
{ For More details see: http://www.gnu.org/copyleft/lgpl.html }
{***********************************************************************}
{ This license was picked so that it could be used in both GPL'd code }
{ AND Commercial code. Open source rocks, but I do write commercial. }
{***********************************************************************}
{ FILE HISTORY }
{***********************************************************************}
{ History wasn't started until version 2.0, but here's the brief. In }
{ 2000, I was helping with a Daily-Time program for work, clock in/out }
{ etc. for the office workers. It was virtually always on, but over and}
{ over again people would minimize the program, and later re-open, not }
{ looking to see if it was still open. Thus several instances would be }
{ opened at a time, so I looked online to find a fix, but while I found}
{ 3 components for allowing only one instance of a program, only one }
{ seemed to work, and it didn't allow bringing the former app to front.}
{ I wrote this component from scratch to try and resolve this problem }
{ myself. All worked well for up until last year, when I made changes }
{ in the way it raised the app to use FindWindow, to find the handle, }
{ at which point it didn't work properly all the time. I got Kylix, and}
{ again looked online, and nothing, nada, zip... not even tutorial on }
{ how!! So I started porting this component over, obviously starting }
{ from scratch again, only really using the minimal framework I had }
{ already, and then started trying to fix the Windows code I broke. }
{***********************************************************************}
{Version 2.3 (Frank Ingermann, 9/20/2002) }
{ }
{ 1.)Minor fix to make sure component isn't run in ide (csDesigning) }
{***********************************************************************}
{Version 2.2 (Andrew Johnson, 5/6-7/2002) }
{ }
{ Andrew Johnson, 5/6/2002 }
{ 1.)Re-added Ifdef Windows in loaded, this fixed compiling in Linux }
{ 2.)Changed default tab to Additional, j.i.c. other people use it ;-) }
{ 3.)Added a Delphi/Kylix .dcr file, with a unique component icon.. }
{ 4.)Added FinalizeLock routine }
{ 5.)Changed RaiseFormerInstance to DoRaisePriorInstance }
{ 6.)Merged ReadAndVerifyPid with to HasFormerInstance }
{ 7.)Changed OnNewInstance to InitializeLock }
{ 8.)Merged CreateLockFile with InitializeLock }
{ 9.)Merged LockDirectory with Create }
{ 10.)Changed Windows to use OpenMutex to check for prev. Instance }
{ 11.)Cleanup, Cleanup, everywhere! }
{ 12.)Made sure to define Windows for Delphi 4/5 }
{ }
{ Andrew Johnson, 5/7/2002 }
{ 1.)Added more Error Handling, and a bit of basic source documentation}
{***********************************************************************}
{Version 2.1 (Andrew Johnson, 4/28-29/2002) }
{ }
{ Andrew Johnson, 4/28/2002 }
{ 1.)Revised Linux Support, adding SIGUSR1 code for RaisePriorInstance }
{ 2.)Cleaned up and merged Windows/Linux routines using $IFDef's }
{ 3.)Created EOneInstance Error and used throughout }
{ 4.)Added InformUser Code, and fixed destory code under Linux }
{ }
{ Andrew Johnson, 4/29/2002 }
{ 1.)More clean up and merging Windows/Linux routines }
{ 2.)Changed Windows Version, AppSwitch to use Application's Title, }
{ instead of Application.MainForm's }
{ 3.)Merged AppSwitch code into RaisePriorInstance }
{ 4.)Changed Windows Version of RaisePriorInstance, to raise App first }
{ then popup(if valid), then set popup as foreground windows. This }
{ ensures that if the entire app(not just the popup) is minimized }
{ all forms are restored, in proper order, THEN popup is shown, }
{ focused and brought to front. This apears to have have fixed all }
{ major problems with RaisePriorInstance code for Windows. }
{***********************************************************************}
{Version 2.0 (Andrew Johnson, 4/26/2002) }
{ }
{ 1.)Added Initial Linux Support, using LockFile }
{ 2.)Added License,and Version History }
{ 3.)Updated Copyright Date's }
{***********************************************************************}
Bookmarks