Link to home
Start Free TrialLog in
Avatar of DelRunner
DelRunnerFlag for Sweden

asked on

Check if a program is running

Hi there !
Could anyone tell me how to check if a particular program (.exe) is running, and if so how to kill / close it ?

DelRunner
Avatar of f15iaf
f15iaf
This is the code which checks if a specific exe filename is running:
You can terminate it's process by finding the process of the filename and using
teminateprocess function

Uses
  Psapi, tlhelp32;

procedure CreateWin9xProcessList(List : TStringList) ;
var
  hSnapShot : THandle;
  ProcInfo : TProcessEntry32;
begin
  if List = nil then Exit ;
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapShot <> THandle(-1)) then
  begin
    ProcInfo.dwSize := sizeof(ProcInfo) ;
    if (Process32First(hSnapshot, ProcInfo)) then
    begin
     List.Add( ProcInfo.szExeFile) ;
     while (Process32Next(hSnapShot, ProcInfo)) do
      List.Add(ProcInfo.szExeFile) ;
    end ;
    CloseHandle(hSnapShot) ;
  end ;
end ;

procedure CreateWinNTProcessList(List : TStringList) ;
var
  PIDArray : array [0..1023] of DWORD ;
  cb : DWORD ;
  I : integer ;
  ProcCount : integer ;
  hMod : HMODULE ;
  hProcess : THandle ;
  ModuleName : array [0..300] of char ;
begin
  if List = nil then Exit ;
  EnumProcesses(@PIDArray, sizeof(PIDArray), cb) ;
  ProcCount := cb div sizeof(DWORD) ;
  for I := 0 to ProcCount-1 do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
    PROCESS_VM_READ,
    false,
    PIDArray[I]) ;
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod, sizeof(hMod), cb) ;
      GetModuleFilenameEx(hProcess,hMod,ModuleName,sizeof(ModuleName));
      List.Add(ModuleName);
      CloseHandle(hProcess);
    end;
  end;
end;

procedure GetProcessList(Var List : TStringList) ;
var ovi : TOSVersionInfo ;
begin
  if List = nil then Exit ;
  ovi.dwOSVersionInfoSize := sizeof(TOSVersionInfo) ;
  GetVersionEx(ovi) ;
  case ovi.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS : CreateWin9xProcessList(List) ;
    VER_PLATFORM_WIN32_NT : CreateWinNTProcessList(List) ;
  end
end;

function EXE_Running(FileName : String; fullpath : boolean) : boolean;
var
  i : integer ;
  MyProcList : TStringList;
begin
 MyProcList := TStringList.Create;
 try
   GetProcessList(MyProcList) ;
   result := false;
   if MyProcList = nil then Exit;
    for i := 0 to MyProcList.Count - 1 do
    begin
      if not fullpath then
      begin
       if CompareText(ExtractFileName(MyProcList.Strings[i]),FileName) = 0 then result := true
      end else
       if CompareText(MyProcList.Strings[i],FileName) = 0 then result := true;
     if result then break;
    end;
  finally
   MyProcList.Free ;
 end;
end;
Avatar of Mohammed Nasman
Mohammed Nasman
Flag of Palestine, State of image
Hello

  Use FindWindow and WM_CLose to to close the application

procedure TForm1.Button1Click(Sender: TObject);
var
  H : THandle;
begin
  H := FindWindow('notepad',nil);
  PostMessage(H,WM_Close,0,0);
end;

if you want to force the application to close without saving use WM_Quit

also you can find the application by it's titlebar caption
like
  H := FindWindow(nil,'untitled - notepad');
Avatar of f15iaf
f15iaf
But waht if the application have no windows and what if the application stacked
Avatar of f15iaf
f15iaf
Secondly you can use exitprocess instead of terminate process function which is the same that you told but saves the changes.
Avatar of smurff
smurff
I think this came from another question here at EE so I cant take the credit really. Cut n paste this and save it to ProcessViewer.pas and save it in your program directory.

unit ProcessViewer;

interface

uses
     Windows, Dialogs, SysUtils, Classes, ShellAPI, TLHelp32, Forms;

const
     SleepForReCheck=5000;

type TProcessInfo=record
     FileName: string;
     Caption: string;
     Visible: boolean;
     Handle: DWord;
     PClass: string;
     ThreadID: DWord;
     PID: DWord;
end;


var
     DateiList,CaptionList,VisibleList,HandleList,ClassList,ThreadIdList,PIDList: TStringList;
     ProcessInfo: array of TProcessInfo;

function EnumWindowsProc(hWnd: HWND; lParam: LPARAM): Bool; stdcall;
function KillProcessByPID(PID: DWord): boolean;
function KillProcessByFileName(FileName: string; KillAll: boolean): boolean;
procedure GetProcessList;
function GetFileNameFromHandle(Handle: hwnd):string;
function IsFileActive(FileName: String): boolean;

implementation

procedure GetProcessList;
var
     i,Laenge: integer;
begin
DateiList.Clear;
HandleList.Clear;
ClassList.Clear;
CaptionList.Clear;
VisibleList.Clear;
ThreadIdList.Clear;
PIDList.Clear;
EnumWindows(@EnumWindowsProc, 0);
Laenge:=DateiList.Count;
SetLength(ProcessInfo,Laenge);
for i:=0 to Laenge-1 do
begin
     DateiList[i]:=UpperCase(DateiList[i]);
     with ProcessInfo[i] do
     begin
          FileName:=DateiList[i];
          Caption:=CaptionList[i];
          Visible:=VisibleList[i]='1';
          Handle:=StrToInt64(HandleList[i]);
          PClass:=ClassList[i];
          ThreadID:=StrToInt64(ThreadIdList[i]);
          PID:=StrToInt64(PIDList[i]);
     end;
end;
end;

function IsFileActive(FileName: String): boolean;
var
     i: integer;
begin
result:=false;
if FileName='' then exit;
GetProcessList;
FileName:=UpperCase(ExtractFileName(FileName));
for i:=0 to Length(ProcessInfo)-1 do
begin
     if Pos(FileName,ProcessInfo[i].FileName)>0 then
     begin
          result:=true;
          break;
     end;
end;
end;

function GetFileNameFromHandle(Handle: hwnd):string;
var
     PID: DWord;
     aSnapShotHandle: THandle;
     ContinueLoop: Boolean;
     aProcessEntry32: TProcessEntry32;
begin
GetWindowThreadProcessID(Handle, @PID);
aSnapShotHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
aProcessEntry32.dwSize := SizeOf(aProcessEntry32);
ContinueLoop := Process32First(aSnapShotHandle, aProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
     if aProcessEntry32.th32ProcessID = PID then
     begin
          result:=aProcessEntry32.szExeFile;
          break;
     end;
     ContinueLoop := Process32Next(aSnapShotHandle, aProcessEntry32);
end;
CloseHandle(aSnapShotHandle);
end;

function EnumWindowsProc(hWnd: HWND; lParam: LPARAM): Bool;
var
     Capt,Cla: array[0..255] of char;
     Datei: string;
     ident: dword;
begin
GetWindowText(hWnd, Capt, 255);
GetClassName(hwnd,Cla,255);
ThreadIdList.Add(IntToStr(GetWindowThreadProcessId(hwnd,nil)));
Datei:=GetFileNameFromhandle(hwnd);
DateiList.Add(Datei);
HandleList.Add(IntToStr(HWnd));
if IsWindowVisible(HWnd) then VisibleList.Add('1') else VisibleList.Add('0');
ClassList.Add(Cla);
CaptionList.Add(Capt);
GetWindowThreadProcessId(StrToInt(HandleList[HandleList.Count-1]),@ident);
PIDList.Add(IntToStr(ident));
Result:=true;
end;

function KillProcessByPID(PID : DWord): boolean;
var
     myhandle : THandle;
     i: integer;
begin
myhandle := OpenProcess(PROCESS_TERMINATE, False, PID);
TerminateProcess(myhandle, 0);
for i:=0 to SleepForReCheck do Application.ProcessMessages; //Genug Zeit geben
GetProcessList;
Result:=PIDList.IndexOf(IntToStr(PID))=-1;
end;

function KillProcessByFileName(FileName: string; KillAll: boolean): boolean;
var
     i: integer;
     FileFound: boolean;
begin
result:=false;
if FileName='' then exit;
FileName:=UpperCase(ExtractFileName(FileName));
result:=true;
GetProcessList;
if KillAll then
begin
     //Kill all
     FileFound:=false;
     repeat
          GetProcessList;
          FileFound:=false;
          for i:=0 to DateiList.Count-1 do
          begin
               if Pos(Filename,DateiList[i])>0 then
               begin
                    FileFound:=true;
                    break;
               end;
          end;
          if i<DateiList.Count then
          begin
               if not KillProcessByPID(StrToInt64(PIDList[i])) then
               begin
                    result:=false;
                    exit;
               end;
          end;
     until not FileFound;
end else
begin
     //Kill one
     for i:=0 to DateiList.Count-1 do
     begin
          if Pos(Filename,DateiList[i])>0 then break;
     end;
     if i<DateiList.Count then
     begin
          if not KillProcessByPID(StrToInt64(PIDList[i])) then
          begin
               result:=false;
               exit;
          end;
     end;
end;
end;

initialization
DateiList:=TStringList.Create;
HandleList:=TStringList.Create;
ClassList:=TStringList.Create;
CaptionList:=TStringList.Create;
VisibleList:=TStringList.Create;
ThreadIdList:=TStringList.Create;
PIDList:=TStringList.Create;

finalization
DateiList.Free;
HandleList.Free;
ClassList.Free;
CaptionList.Free;
VisibleList.Free;
ThreadIdList.Free;
PIDList.Free;

end.



Then to use it just add ProcessViewer to your uses and an example is like this:


procedure Torm1.Button1Click(Sender: TObject);
Begin
  If isFileActive('Notepad.exe') then
    Begin
      ShowMessage('Notepad is found, im about to kill it!);
      killProcessByFilename('Notepad.exe',True);
    end;
end;

Regards
Smurff
Avatar of Mohammed Nasman
Mohammed Nasman
Flag of Palestine, State of image
Hello

  here's a better code, this will kill the application by giving it's exe name, like notepad.exe, winword.exe and so on

//=========
uses
Tlhelp32;

function KillTask(ExeFileName: string): integer;
const
  PROCESS_TERMINATE=$0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot
  (TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,
  FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
    UpperCase(ExeFileName))
    or (UpperCase(FProcessEntry32.szExeFile) =
    UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),
    FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  KillTask('winword.exe');
end;


Best regards
Mohammed Nasman
Avatar of ginsonic
ginsonic
Flag of Romania image
...get a list of all running Exe-Files/ Check if a Exe-File is running

Uses
  Psapi, tlhelp32;

procedure CreateWin9xProcessList(List : TStringList) ;
var
  hSnapShot : THandle;
  ProcInfo : TProcessEntry32;
begin
  if List = nil then Exit ;
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapShot <> THandle(-1)) then
  begin
    ProcInfo.dwSize := sizeof(ProcInfo) ;
    if (Process32First(hSnapshot, ProcInfo)) then
    begin
     List.Add( ProcInfo.szExeFile) ;
     while (Process32Next(hSnapShot, ProcInfo)) do
      List.Add(ProcInfo.szExeFile) ;
    end ;
    CloseHandle(hSnapShot) ;
  end ;
end ;

procedure CreateWinNTProcessList(List : TStringList) ;
var
  PIDArray : array [0..1023] of DWORD ;
  cb : DWORD ;
  I : integer ;
  ProcCount : integer ;
  hMod : HMODULE ;
  hProcess : THandle ;
  ModuleName : array [0..300] of char ;
begin
  if List = nil then Exit ;
  EnumProcesses(@PIDArray, sizeof(PIDArray), cb) ;
  ProcCount := cb div sizeof(DWORD) ;
  for I := 0 to ProcCount-1 do
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
    PROCESS_VM_READ,
    false,
    PIDArray[I]) ;
    if (hProcess <> 0) then
    begin
      EnumProcessModules(hProcess, @hMod, sizeof(hMod), cb) ;
      GetModuleFilenameEx(hProcess,hMod,ModuleName,sizeof(ModuleName));
      List.Add(ModuleName);
      CloseHandle(hProcess);
    end;
  end;
end;

procedure GetProcessList(Var List : TStringList) ;
var ovi : TOSVersionInfo ;
begin
  if List = nil then Exit ;
  ovi.dwOSVersionInfoSize := sizeof(TOSVersionInfo) ;
  GetVersionEx(ovi) ;
  case ovi.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS : CreateWin9xProcessList(List) ;
    VER_PLATFORM_WIN32_NT : CreateWinNTProcessList(List) ;
  end
end;

function EXE_Running(FileName : String; fullpath : boolean) : boolean;
var
  i : integer ;
  MyProcList : TStringList;
begin
 MyProcList := TStringList.Create;
 try
   GetProcessList(MyProcList) ;
   result := false;
   if MyProcList = nil then Exit;
    for i := 0 to MyProcList.Count - 1 do
    begin
      if not fullpath then
      begin
       if CompareText(ExtractFileName(MyProcList.Strings[i]),FileName) = 0 then result := true
      end else
       if CompareText(MyProcList.Strings[i],FileName) = 0 then result := true;
     if result then break;
    end;
  finally
   MyProcList.Free ;
 end;
end;


// Example 1: Is a Exe-File running ?
procedure TForm1.Button1Click(Sender: TObject);
begin
 if EXE_Running('notepad.exe',false) then
    ShowMessage('EXE is running')
 else
    ShowMessage('EXE is not running');
end;


// Example 2: List running Exe-Files
procedure TForm1.Button3Click(Sender: TObject);
var
  i : integer ;
  MyProcList : TStringList;
begin
 MyProcList := TStringList.Create;
 try
   GetProcessList(MyProcList) ;
   if MyProcList = nil then Exit;
    for i := 0 to MyProcList.Count - 1 do
      ListBox1.items.add(MyProcList.Strings[i]);
 finally
   MyProcList.Free;
 end;
end;
Avatar of ginsonic
ginsonic
Flag of Romania image
Sorry f15iaf .I have add just the samples .
I have see you comment to late .

Regards,
Nick
ASKER CERTIFIED SOLUTION
Avatar of Madshi
Madshi
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of rondi
rondi
Madshi's unit rocks!
How come you're so bad-ass at Delphi, Madshi?
Avatar of smurff
smurff
Madshi,

Once again Ive learnt alot from your code... Nice unit!
Regards
Danny
Avatar of Madshi
Madshi
:-)  Thanx, guys...

>> How come you're so bad-ass at Delphi, Madshi?

I'm not, I'm just pretending...   =;-D