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!

*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.

Jobs

Modifying Project Types

Modifying Project Types

(OP)
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:

CODE

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

Then the code I use can be:

CODE

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?

RE: Modifying Project Types

(OP)
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:

CODE

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:

CODE

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.

RE: Modifying Project Types

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.

RE: Modifying Project Types

(OP)
@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:

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');
  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.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

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