×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

How To

How to ensure only one instance of application runs at once? by Glenn9999
Posted: 14 Nov 15

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. 

Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close