Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to ensure only one instance of application runs at once?

How To

How to ensure only one instance of application runs at once?

by  Glenn9999  Posted    (Edited  )
This is a unit that is included in the main project source which handles any run-once chores. Optionally, it will also link code into the Application instance which will bring up the program if another copy of it is run.

Code:
unit runonce;
{
 This is run once code by Glenn9999, as suggested by
 http://delphi.about.com/od/windowsshellapi/l/aa100703b.htm

 The idea behind this code is to try to make a single unit solution that can
 handle any "run once" chores, including making the original program come to
 the forefront if a copy of it is run.  It is meant to be included only *once*
 in the main project source.

 Sample usage:

  RunOnlyOnce('RunOnceDemo');  // must be at the very first.
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
// optionally, this call can be included to bring up the form.  If used, it must
// appear before Application.Run.
  RegisterBringUpForm(Application);
  Application.Run;
}

interface
  uses windows, forms;

type
  TAppMessageClass = class(TObject)
  private
    FApplication: TApplication;  // store it upon register so AppMessage can use it
  public
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  end;

var
  FSemaPhore: THandle;
  MyMsg: Cardinal;
  MyEvents: TAppMessageClass;
  OldMessageEvent: TMessageEvent;

procedure RunOnlyOnce(tagID: String);
procedure RegisterBringUpForm(Application: TApplication);

implementation

procedure RunOnlyOnce(tagID: AnsiString);
// this contains code which has a scheme which reveals whether the program has
// been run previously.  Detection is done based on the specific tagID passed
// the routine, which should be uniquely defined within the program.
  begin
    MyMsg := RegisterWindowMessage(PAnsiChar(tagID));
    FSemaPhore := CreateMutex(nil, True, PAnsiChar(tagID));
    if ((FSemaPhore = 0) or (GetLastError = ERROR_ALREADY_EXISTS)) then
      begin
        // another copy of this program is running somewhere.  Broadcast my message
        // to other windows and shut down.
        PostMessage(HWND_BROADCAST, MyMsg, 0, 0);
        CloseHandle(FSemaPhore);
        ExitProcess(0);
      end;
  end;

procedure RegisterBringUpForm(Application: TApplication);
// this links code into the Application instance which will cause the program
// to bring up its main form when it receives the message to do so in "RunOnlyOnce"
  begin
    MyEvents.FApplication := Application;
    // save old message event.
    OldMessageEvent := Application.OnMessage;
    // set message event to ours.
    Application.OnMessage := MyEvents.AppMessage;
  end;

procedure TAppMessageClass.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  // run old message event if one was present.
  if Assigned(OldMessageEvent) then
    OldMessageEvent(Msg, Handled);
  // message handler: If it's my message, then bring the window up.
  if Msg.Message = MyMsg then
    begin
      FApplication.Restore;
      SetForeGroundWindow(FApplication.MainForm.Handle);
      Handled := true;
    end;
end;

initialization
  MyEvents := TAppMessageClass.Create;
finalization
  MyEvents.Free;
  if FSemaPhore <> 0 then
    CloseHandle(FSemaPhore);

end.
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top