Modifying Project Types 1

[Glenn9999]

One thing I've done with some of my programs is put a snippet of code in the beginning of the project source file in order to detect whether a copy is running and stop it. More or less, such a thing has to go in the main module of the project. So if we start with:

Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;

Then the code I use can be:

function CheckExistence(var SemHandle: THandle; ID: String): Boolean;
  begin
    Result := true;
    SemHandle := CreateSemaphore(nil,0,1,PChar(ID));
    if ((SemHandle <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
      begin
        CloseHandle(SemHandle);
        Result := false;
        ExitProcess(0);
      end;
  end; 

var FSemaPhore: Thandle;

if CheckExistence(FSemaPhore, 'Form1Test') then
  try
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  finally
    CloseHandle(FSemaPhore);
  end;

Obviously, the question becomes modularizing this code, as this still seems a substantial amount of required code to support the function. Is there a way around this I'm not seeing, or would it require modifying the "new Project" type in order to put the code out like this? Or is it more trouble than it's worth?

 

[Glenn9999]

Okay, I thought about this some more and realized I probably was overthinking it. ExitProcess shuts down the program. Then I could put the semaphore handle within the unit and make sure the handle from the "good execution" gets cleaned up with the finalization section. So, if I have a unit with code like so:

unit runonce;

interface
  uses windows;

var
  FSemaPhore: THandle;

  procedure CheckExistence(tagID: String);

implementation

  procedure CheckExistence(tagID: String);
    begin
      FSemaPhore := CreateSemaphore(nil,0,1, PAnsiChar(tagID));
      if ((FSemaPhore <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
        begin
//  ***** debug line just to show us that any subsequent executions are getting caught *****
//          MessageDlg('You can only run this program once.', mtInformation, [mbOK], 0);
          CloseHandle(FSemaPhore);
          ExitProcess(0);
        end;
    end;

initialization
finalization
  if FSemaPhore <> 0 then
    CloseHandle(FSemaPhore);
end.

I could simply just add the unit and then put an initial call to the (now) procedure, and if it's a second execution, the whole thing gets shut down:

CheckExistence('RunOnceTest');
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;

Does this seem like a good idea in how to approach the problem? I may have to add a scheme for it to bring the main window of the program to the front just to be complete about doing this. But the idea seems good?

Edit: The latest version has a scheme which brings up the main form of the program if another copy of it is run. It may have issues somewhere, but if there is enough interest, I can put it up for review and can FAQ it if it seems good.

 

[majlumbo]

I've always used the approach detailed in this article: Delphi: Restricting a program to running only once, using mutexes

It does have code that is supposed to bring up any previous version of the executable if it is already running, but in newer versions of Windows, it simply flashes the icon.

Using a simpler approach may be worth looking at.

 

[Glenn9999]

@majlumbo Actually the method I use is very similar to bring up the window. The question was making it all unit-contained and modular so you don't have to recode it every time you want it. As for what it does, I might go ahead and post it as it basically says the rest of what I was going to respond with:

unit runonce;
{
 This is run once code by Glenn9999, as suggested by
 [URL unfurl="true"]http://delphi.about.com/od/windowsshellapi/l/aa100703b.htm[/URL]

 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');
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  RegisterBringUpForm(Application);
  Application.Run;

}

interface
  uses windows, dialogs, 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;

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

implementation

procedure RunOnlyOnce(tagID: String);
// 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;
    // probably could be a little "safer" here and save an old event so it could be run.
    Application.OnMessage := MyEvents.AppMessage;
  end;

procedure TAppMessageClass.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  // message handler: If it's my message, then bring the window up.
  if Msg.Message = MyMsg then
    begin
      FApplication.Restore;
      SetForeGroundWindow(FApplication.MainForm.Handle);
//      SetWindowPos(FApplication.MainForm.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
      Handled := true;
    end;
end;

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

If it's not the greatest idea, it's still a good demo on how to hook an event out of a unit file, which might help for something like limiting a TEdit to numerics.

 

[Glenn9999]

FAQ Posted: faq102-7857 It is as above, except I added saving the old message event and running it (if present).