Unique processes

[BradenMurphy]

Hey,
I would like to know how to only allowing one instance of a program to run at once. Ie: You can't run the application multiple times creating multiple processes. I only want to allow one instance of that application to be running at any given time.

[sknake]

Use a mutex:

MutexUt.pas: (Change 'LeatherPDF' to your application name)

unit MutexUt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Forms;

function IsPrevInst: Boolean;
procedure CheckPrevInstEx(MainFormClassName,
                          MainFormCaption : String);

implementation

{---------------------------------------------}

function IsPrevInst: Boolean;
var
  semName,
  appClass: PChar;
  hSem    : THandle;
  hWndMe  : HWnd;
  appTitle: Array[0..MAX_PATH] of Char;
begin
  // Init


  Result := FALSE;
  GetMem(semName,15);
  GetMem(appClass,15);

  StrPCopy(semName,'LeatherPDF');

  StrPCopy(appClass,'TApplication');

  StrPCopy(appTitle,ExtractFileName(Application.Title));

  // Create a Semaphore in memory.  If this is the
  // first instance, then hSem's value should be 0.
  hSem := CreateSemaphore(nil,0,1,semName);

  // Check to see if the semaphore exists
  if (hSem <> 0) and (GetLastError() =
                      ERROR_ALREADY_EXISTS) then
    begin
      CloseHandle(hSem);
      // Get the current window's handle then change
      // its title so we can look for the other instance
      hWndMe :=  FindWindow(appClass,appTitle);
      SetWindowText(hWndMe,'ZZZZZZZ');

      // Search for other instance of this window then bring
      // it to the top of the Z-order stack.  We find it by
      // matching the Application Class and 
      // Application Title.
      hWndMe := FindWindow(appClass,appTitle);
      if (hWndMe <> 0) then
        begin
          //BringWindowToTop(hWndMe);
          //ShowWindow(hWndMe,SW_SHOWNORMAL);
        end;

      Result := TRUE;
    end;

  // Destroy PChars
  FreeMem(semName,15);
  FreeMem(appClass,15);
end;

{---------------------------------------------}

procedure CheckPrevInstEx(MainFormClassName,
                          MainFormCaption : String);
var
  PrevWnd: HWnd;
  Mutex  : THandle;
begin
  {$IFDEF Win32}
  Mutex := CreateMutex(NIL, False, 'InstanceMutex');
  if WaitForSingleObject(Mutex, 10000) = WAIT_TIMEOUT then
    Application.Terminate;
  {$ELSE}
  if HPrevInst = 0 then
    Application.Terminate;
  {$ENDIF}

  PrevWnd := FindWindow(PChar(MainFormClassName),
                        PChar(MainFormCaption));
  if PrevWnd <> 0 then
    PrevWnd := GetWindow(PrevWnd, GW_OWNER);
  if PrevWnd <> 0 then
    begin
      if IsIconic(PrevWnd) then
        ShowWindow(PrevWnd,SW_SHOWNORMAL)
      else
        {$IFDEF Win32}
          SetForegroundWindow(PrevWnd);
        {$ELSE}
          BringWindowToTop(PrevWnd);
        {$ENDIF}
      Application.Terminate;
    end;
  ReleaseMutex(Mutex);
  CloseHandle(Mutex);
end;

{---------------------------------------------}

end.

Then in the project file you should call application.Run like:

uses MutexUt in 'MutexUt.pas';
...
begin

  Application.Initialize;
  Application.Title := 'Leather PDF Utility';
  Application.ShowMainForm := not (ParamStr(1) = '/auto');
  Application.CreateForm(TMainFm, MainFm);

  if not IsPrevInst then
    Application.Run;
end.

[BradenMurphy]

awesome tyvm:)

[sknake]

I hope it works for you and good luck!

Please mark this thread as solved if I have answered your question.

[mediastar]

I appreciate snake's insight into the unique-instance problem. But I use a simpler method in the project source as follows.

-----------------------------------------

var hMutex: THandle;
begin
  hMutex := CreateMutex(nil, True, 'AnyNameYouChoose');
  if GetLastError <> Error_Already_Exists then begin
    Application.Initialize;
    Application.CreateForm(TMainFm, MainFm);
    Application.Run;
  end;
  ReleaseMutex(hMutex);
end.