Suspend/resume processes as PsSuspend does

Question

I hope this post is not a duplicate one. Let me explain:

I have considered the similar post How to pause / resume any external process under Windows? but with C++/Python preference and yet without an accepted answer as of the time of posting.

---

My Question:

I'm interested in a possible implementation in Delphi of the functionality provided by PsSuspend by Mark Russinovich of Windows Sysinternals.

Quotes:

PsSuspend lets you suspend processes on the local or a remote system, which is desirable in cases where a process is consuming a resource (e.g. network, CPU or disk) that you want to allow different processes to use. Rather than kill the process that's consuming the resource, suspending permits you to let it continue operation at some later point in time.

Thank you.

---

Edit:

A partial implementation will do. Remote capability can be dropped.

Answer 1

You can try to use the following code. It uses the undocumented functions NtSuspendProcess and NtResumeProcess. I've tried it on Windows 7 64-bit from the 32-bit application built in Delphi 2009 and it works for me. Note that these functions are undocumented thus can be removed from future versions of Windows.

Update

The SuspendProcess and ResumeProcess wrappers from the following code are now functions and returns True if succeed, False otherwise.

type
  NTSTATUS = LongInt;
  TProcFunction = function(ProcHandle: THandle): NTSTATUS; stdcall;

const
  STATUS_SUCCESS = $00000000;
  PROCESS_SUSPEND_RESUME = $0800;

function SuspendProcess(const PID: DWORD): Boolean;
var
  LibHandle: THandle;
  ProcHandle: THandle;
  NtSuspendProcess: TProcFunction;
begin
  Result := False;
  LibHandle := SafeLoadLibrary('ntdll.dll');
  if LibHandle <> 0 then
  try
    @NtSuspendProcess := GetProcAddress(LibHandle, 'NtSuspendProcess');
    if @NtSuspendProcess <> nil then
    begin
      ProcHandle := OpenProcess(PROCESS_SUSPEND_RESUME, False, PID);
      if ProcHandle <> 0 then
      try
        Result := NtSuspendProcess(ProcHandle) = STATUS_SUCCESS;
      finally
        CloseHandle(ProcHandle);
      end;
    end;
  finally
    FreeLibrary(LibHandle);
  end;
end;

function ResumeProcess(const PID: DWORD): Boolean;
var
  LibHandle: THandle;
  ProcHandle: THandle;
  NtResumeProcess: TProcFunction;
begin
  Result := False;
  LibHandle := SafeLoadLibrary('ntdll.dll');
  if LibHandle <> 0 then
  try
    @NtResumeProcess := GetProcAddress(LibHandle, 'NtResumeProcess');
    if @NtResumeProcess <> nil then
    begin
      ProcHandle := OpenProcess(PROCESS_SUSPEND_RESUME, False, PID);
      if ProcHandle <> 0 then
      try
        Result := NtResumeProcess(ProcHandle) = STATUS_SUCCESS;
      finally
        CloseHandle(ProcHandle);
      end;
    end;
  finally
    FreeLibrary(LibHandle);
  end;
end;

Answer 2

There is no SuspendProcess API call in Windows. So what you need to do is:

1. Enumerate all the threads in the process. See RRUZ's answer for sample code.
2. Call SuspendThread for each of these threads.
3. In order to implement the resume part of the program, call ResumeThread for each thread.

Answer 3

There is a race condition for the "suspend all threads" implementation - what happens if the program you are trying to suspend creates one or more threads between the time that you create the snapshot and the time that you complete suspending?

You could loop, getting another snapshot and suspending any unsuspending threads, exiting only when you found none.

The undocumented function avoids this issue.

Answer 4

I just found the following snippets here (Author: steve10120).

I think they are valuables and I can't help posting them also as an alternative answer to my own question.

---

Resume Process:

function ResumeProcess(ProcessID: DWORD): Boolean;
 var
   Snapshot,cThr: DWORD;
   ThrHandle: THandle;
   Thread:TThreadEntry32;
 begin
   Result := False;
   cThr := GetCurrentThreadId;
   Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
   if Snapshot <> INVALID_HANDLE_VALUE then
    begin
     Thread.dwSize := SizeOf(TThreadEntry32);
     if Thread32First(Snapshot, Thread) then
      repeat
       if (Thread.th32ThreadID <> cThr) and (Thread.th32OwnerProcessID = ProcessID) then
        begin
         ThrHandle := OpenThread(THREAD_ALL_ACCESS, false, Thread.th32ThreadID);
         if ThrHandle = 0 then Exit;
         ResumeThread(ThrHandle);
         CloseHandle(ThrHandle);
        end;
      until not Thread32Next(Snapshot, Thread);
      Result := CloseHandle(Snapshot);
     end;
 end;

---

Suspend Process:

function SuspendProcess(PID:DWORD):Boolean;
 var
 hSnap:  THandle;
 THR32:  THREADENTRY32;
 hOpen:  THandle;
 begin
   Result := FALSE;
   hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
   if hSnap <> INVALID_HANDLE_VALUE then
   begin
     THR32.dwSize := SizeOf(THR32);
     Thread32First(hSnap, THR32);
     repeat
       if THR32.th32OwnerProcessID = PID then
       begin
         hOpen := OpenThread($0002, FALSE, THR32.th32ThreadID);
         if hOpen <> INVALID_HANDLE_VALUE then
         begin
           Result := TRUE;
           SuspendThread(hOpen);
           CloseHandle(hOpen);
         end;
       end;
     until Thread32Next(hSnap, THR32) = FALSE;
     CloseHandle(hSnap);
   end;
 end;

---

Disclaimer:

I didn't test them at all. Please enjoy and don't forget to feedback.