Merlin's Delphi Forge

I received tip from Mike Gajewski, one of our readers. This is the code you need to find out if a certain program is running. The IsProcess() routine checks if the specific filename is running. This tip can be useful when your application should or needs some other application running in order to run properly/at all.

OK, here are the sources of unit EnumProc:

uses
  SysUtils, Classes;
...
const
  MAX_PATH = 260;
  TH32CS_SNAPPROCESS = 2;
...
type
  TProcessEntry32 = packed record
    iSize,
    iUsage,
    iProcessID,
    iDefaultHeapId,
    iModuleId,
    iThreads,
    iParentProcessId,
    iPriClassBase,
    iFlags: Integer;
    aExeFile: array[0..MAX_PATH] of Char;
  end;

function CreateToolHelpSnapShot(lFlags, lProcessId: Longint): Longint; stdcall;
function ProcessFirst(hSnapshot: longint; var uProcess: TProcessEntry32): Longint; stdcall;
function ProcessNext(hSnapshot: Longint; var uProcess: TProcessEntry32): Longint; stdcall;
procedure CloseHandle(hPass: Longint); StdCall;

function IsProcess(sExe: string): Boolean;
procedure GetProcesses(var ProcessList: TStringList);

implementation

function CreateToolHelpSnapShot; external 'kernel32.dll' name 'CreateToolhelp32Snapshot';
function ProcessFirst; external 'kernel32.dll' name 'Process32First';
function ProcessNext; external 'kernel32.dll' name 'Process32Next';
procedure CloseHandle; external 'kernel32.dll';

function IsProcess(sExe: string): Boolean;
(*
** This routine examines Windows processes currently running to see if a
** certain program is running.
**
** sExe  : The executable name of the program to check.
** Result: True if the program is running, False otherwise.
*)
var
  liI, lSnapShot: Longint;
  rProcess: TProcessEntry32;
begin
  Result := False;
  ExeName := UpperCase(ExeName);
  lSnapShot := CreateToolHelpSnapShot(TH32CS_SNAPPROCESS, 0);
  if lSnapShot <> 0 then begin
    rProcess.lSize := SizeOf(rProcess);
    lI := ProcessFirst(lSnapShot, rProcess);
    while lI <> 0 do begin
      if Pos(ExeName, UpperCase(rProcess.sExe)) <> 0 then begin
        Result := True;
        Break;
      end;
      lI := ProcessNext(lSnapShot, rProcess);
    end;
    CloseHandle(lSnapShot);
  end;
end;

procedure GetProcesses(var ProcessList: TStringList);
(* This procedure will retrieve a list of Windows processes currently running.
**
** ProcessList: TStringList variable to fill with the running process names.
**
** !!Note: ProcessList will be empty if an error occurs
*)
var
  lI, lSnapShot: Longint;
  rProcess     : TProcessEntry32;
begin
  ProcessList.Clear;
  lSnapShot := CreateToolHelpSnapShot(TH32CS_SNAPPROCESS, 0);
  if lSnapShot <> 0 then begin
    rProcess.lSize := SizeOf(rProcess);
    lI := ProcessFirst(lSnapShot, rProcess);
    while r <> 0 do begin
      ProcessList.Add(rProcess.sExeFile);
      lI := ProcessNext(lSnapShot, rProcess);
    end;
    CloseHandle(lSnapShot);
  end;
end;

Example:

IsProcess('notepad.exe'); // Will return True if Notepad is running

Applications created in Delphi 1 to 4 (not 5 and up) don’t “fly” to the taskbar but hide like in Windows 3.1x. This is because Borland’s programmers turned this function off. Why?! Well, this is because the main window of the program is not the one we create in the IDE. The program’s main window is TApplication, so if the animation were turned on the application would “fly” but it would be kinda weird because it wouldn’t be our main window that would “fly”:) Well, there are a few ways to get over this:

1) You can turn on the window animation in the unit Form. Before doing this though you may want to back up this unit
Here’s the code:

  ...
  procedure ShowWinNoAnimate(Handle: HWnd; CmdShow: Integer);
  var
    Animation: Boolean;
  begin
    Animation := GetAnimation;
    if Animation then
      SetAnimation(False);
    ShowWindow(Handle, CmdShow);
    if Animation then
      SetAnimation(True);
  end;
  ...

Because this procedure is called from other functions it should be changed to:

  ...
  procedure ShowWinNoAnimate(Handle: HWnd; CmdShow: Integer);
  begin
    ShowWindow(Handle, CmdShow);
  end;
  ...

2) I would consider this is the best way. Add this code to your project’s source unit:

  ...
  uses
    Windows;
  ...
  var
    iExStyle: Integer;
  ...
    Application.Initialize;
    iExStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE);

Add this code to your main window’s unit:

  ...
  public
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  ...
  procedure TMainForm.CreateParams(var Params: TCreateParams);
  begin
    inherited CreateParams(Params);
    with Params do
      ExStyle := ExStyle or WS_EX_APPWINDOW;
  end;

  (* This will take care of the Minimize command so that the proper window
   * will "fly" to the taskbar.
   *)
  procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
  begin
   if Message.CmdType and $FFF0 = SC_MINIMIZE then
     WindowState := wsMinimized
   else
     inherited;
  end;

3) This is the worst you can do Use a Delphi component to do the job.