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!

Register Log in
  • 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 do I determine if a program is already running?

System Information

How do I determine if a program is already running?

by  djjd47130  Posted    (Edited  )
In many cases, you may want to know if an application is running. This example not only checks if an application is running, but also tells you how many instances of it there are running. Suppose you have an application, and although you allow it to run multiple times, you may want to put a limit on it to run, let's say no more than 10 times at once. You may also just want to check how many instances of svchost are running. Whatever the reason may be, this function helps you identify this.

(This example is tested with Delphi 7)

First of all, we will be working directly in the application's unit. If the goal is to prevent the application from even starting, then you have to catch it before the main form is even created, and before the application is initialized. In order to get to this unit, go to Project > View Source.

If you're not familiar with how this application unit works, it's not a big problem. Your app may look something like this:

Code: 
program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

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

The 3 lines at the bottom which start with "Application" are the 3 lines we have to prevent from happening if we want to stop this application from running. Depending on your application, there may be more forms being created, so there may be more than 3 lines, which all of them will have to be wrapped in this case.

Now in your 'uses' clause, you need to add these references:
[ul]
[li]Dialogs[/li]
[li]Windows[/li]
[li]TlHelp32[/li]
[li]SysUtils[/li]
[/ul]

Next, we will be adding a new function. Any methods you want to add to this unit should typically be between the end of the uses clause and the line that looks like {$R *.res}. Paste this function there:

Code: 
function ProcessCount(const ExeName: String): Integer;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize:= SizeOf(FProcessEntry32);
  ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
  Result:= 0;
  while Integer(ContinueLoop) <> 0 do begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeName))) then Inc(Result);
    ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

This is the main function which will do this work. "ExeName" identifies the name of the process you want to check, and the result is how many times that process is running. In this case, the ExeName parameter will be the same name as our application, but could be another one (such as svchost).

Now finally, we need to use this function. Everything between 'begin' and 'end.' will be wrapped in an if statement...

Code: 
begin
  if ProcessCount(ExtractFileName(Application.ExeName)) > 1 then begin
    MessageDlg('Application is already running!', mtError, [mbOK], 0);
    Application.Terminate;
  end else begin                       
    Application.Initialize;
    Application.CreateForm(TfrmMain, frmMain);
    Application.Run;
  end;
end.

Now remember, when this is called, if you are checking your same application as I am above, there will always be at least 1 instance of this process running (because this is one instance its self). So check if it's running more than once.

So the final program unit should look something like this:

Code: 
program Project1;

uses
  Forms,
  Dialogs,
  Windows,
  TlHelp32,
  SysUtils,
  Unit1 in 'Unit1.pas' {Form1};

function ProcessCount(const ExeName: String): Integer;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize:= SizeOf(FProcessEntry32);
  ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
  Result:= 0;
  while Integer(ContinueLoop) <> 0 do begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeName))) then Inc(Result);
    ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

{$R *.res}

begin
  if ProcessCount(ExtractFileName(Application.ExeName)) > 1 then begin
    MessageDlg('Application is already running!', mtError, [mbOK], 0);
    Application.Terminate;
  end else begin                       
    Application.Initialize;
    Application.CreateForm(TfrmMain, frmMain);
    Application.Run;
  end;
end.
Register to add this FAQ to your archive
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