14

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

我考虑过类似的帖子如何在 Windows 下暂停/恢复任何外部进程？但有 C++/Python 偏好，但截至发帖时还没有公认的答案。

我的问题：

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

引号：

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

谢谢你。

编辑：

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

4

4 回答 4

13

您可以尝试使用以下代码。它使用未记录的函数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;
于 2012-04-14T12:46:39.480 回答
5

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

  1. 枚举进程中的所有线程。有关示例代码，请参阅RRUZ 的答案。
  2. 调用SuspendThread这些线程中的每一个。
  3. 为了实现程序的恢复部分，调用ResumeThread每个线程。
于 2012-04-14T11:59:18.287 回答
5

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

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

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

于 2012-06-12T02:27:06.243 回答
1

我刚刚在这里找到了以下片段（作者：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;

免责声明：

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

于 2012-04-19T07:45:41.453 回答