[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 265
  • Last Modified:

Kill Task like Task Mgr

I want my Uninstall.exe (running with admin rights) to Terminate my Application that was installed and is running with Std User Rights.
Whereas this works in OS above win XP it fails on Win XP.

function Tform_Main.KillTask(ExeFileName: string): integer;
const
  PROCESS_TERMINATE=$0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle,ProcessHandl: 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
    begin
      ProcessHandl:=OpenProcess(PROCESS_TERMINATE,BOOL(0),FProcessEntry32.th32ProcessID) ;
      Result := Integer(TerminateProcess(ProcessHandl, 0));
      CloseHandle(ProcessHandl);
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

Open in new window

0
Allan_Fernandes
Asked:
Allan_Fernandes
  • 3
  • 2
1 Solution
 
Sinisa VukCommented:
- first you must find process id using EnumProcesses and compare started process module name with your exe file:

function FindExeProcess(sExe: String): Cardinal;
var
  PIDArray: array [0..1023] of DWORD;
  cb: DWORD;
  i, ProcCount: Integer;
  hMod: HMODULE;
  hProcess: THandle;
  ModuleName: array [0..300] of Char;
begin
  Result := 0;
  sExe := UpperCase(sExe);
  EnumProcesses(@PIDArray, SizeOf(PIDArray), cb); //get all process list
  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));
      if UpperCase(ModuleName) = sExe then
      begin
        Result := PIDArray[i];
      end;
      CloseHandle(hProcess);
      if Result > 0 then Break; //found it
    end;
  end;
end;

Open in new window


... and kill process by process id:
procedure KillProcess(hProcessID: Cardinal);
Var
  hProcess : THandle;
  ovExitCode : LongWord;
begin
  try
    if hProcessID<>0 then
    begin
      hProcess:=OpenProcess(PROCESS_TERMINATE, True, hProcessID);
      if hProcess<>0 then
      begin
        GetExitCodeProcess(hProcess, ovExitCode);
        TerminateProcess(hProcess, ovExitCode);
        CloseHandle(hProcess);
      end;
    end;
  except
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  hPid: Cardinal;
begin
  hPid := FindExeProcess('C:\Program Files (x86)\Foxit Software\Foxit Reader\Foxit Reader.exe');
  if hPid > 0 then
    KillProcess(hPid);
end;

Open in new window

0
 
Allan_FernandesAuthor Commented:
The code you have given works only within the User
0
 
Sinisa VukCommented:
check if function FindExeProcess get valid Pid (>0) for different user. Is running exe 64 bit? or 32bit?
try change:
const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
...
hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PIDArray[i]);
...

Open in new window

0
 
Allan_FernandesAuthor Commented:
Sorry that does not help either.
0
 
Sinisa VukCommented:
Ok. You can try WMI.
Ref: WMI and Win32_Process class

function FindExeProcess2(sExe: String): Cardinal;
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator, FWMIService, FWbemObjectSet, FWbemObject: OLEVariant;
  oEnum : IEnumvariant;
  iValue : LongWord;
  PathStr, ModuleName: String;
begin;
  Result := 0;
  sExe := UpperCase(sExe);
  
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_Process','WQL',wbemFlagForwardOnly);
  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    PathStr := '';
    if not VarIsNull(FWbemObject.ExecutablePath) then
      PathStr := FWbemObject.ExecutablePath;
    ModuleName := IncludeTrailingPathDelimiter(PathStr) + FWbemObject.Name;

    if UpperCase(ModuleName) = sExe then
    begin
      Result := FWbemObject.ProcessId; //keep pid
    end;
    FWbemObject:=Unassigned;
    if Result > 0 then Break;
  end;
end;

procedure KillProcess2(hProcessID: Cardinal);
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator, FWMIService, FWbemObjectSet, FWbemObject: OLEVariant;
  oEnum : IEnumvariant;
  iValue : LongWord;
  PathStr, ModuleName: String;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_Process','WQL',wbemFlagForwardOnly);
  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    if FWbemObject.ProcessId = hProcessID then
    begin
      FWbemObject.Terminate();
      FWbemObject:=Unassigned;
      Break;
    end;
  end;
end;

Open in new window


this works for me - as admin user
more useful samples here:
https://theroadtodelphi.wordpress.com/page/12
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now