像 PsSuspend 一样暂停/恢复进程

Question

我希望这篇文章不是重复的。让我解释一下：

我考虑过类似的帖子How to pause / resume any external process under Windows?，但偏好 C++/Python，但截至发帖时还没有公认的答案。

---

我的问题：

我对由 Windows Sysinternals 的 Mark Russinovich 提供的 PsSuspend 提供的功能在 Delphi 中的可能实现感兴趣。

行情：

PsSuspend 允许您暂停本地或远程系统上的进程， 这在进程正在消耗资源的情况下是可取的 （例如网络、CPU 或磁盘）您希望允许不同的进程 使用。而不是杀死消耗资源的进程， 暂停允许您让它在以后继续运行 时间点。

谢谢。

---

编辑：

部分实现即可。可以删除远程功能。

Answer 1

您可以尝试使用以下代码。它使用未记录的函数NtSuspendProcess 和NtResumeProcess。我已经从 Delphi 2009 中内置的 32 位应用程序在 Windows 7 64 位上进行了尝试，它适用于我。请注意，这些函数未记录在案，因此可以从未来版本的 Windows 中删除。

更新

以下代码中的 SuspendProcess 和 ResumeProcess 包装器现在是函数，如果成功则返回 True，否则返回 False。

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

Windows 中没有SuspendProcess API 调用。所以你需要做的是：

1. 枚举进程中的所有线程。示例代码见RRUZ's answer。
2. 为每个线程调用SuspendThread。
3. 为了实现程序的恢复部分，为每个线程调用ResumeThread。

Answer 3

“暂停所有线程”实现存在竞争条件 - 如果您尝试暂停的程序在您创建快照和完成暂停之间创建一个或多个线程，会发生什么情况？

您可以循环，获取另一个快照并挂起任何未挂起的线程，只有在没有找到时才退出。

未记录的函数避免了这个问题。

Answer 4

我刚刚发现了以下sn-ps here（作者：steve10120）。

我认为它们是贵重物品，我不禁将它们发布为我自己问题的替代答案。

---

恢复过程：

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;

---

暂停进程：

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;

---

免责声明：

我根本没有测试它们。请尽情享受，不要忘记反馈。