Delphi 像pssupend一样暂停/恢复进程

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

我曾经考虑过类似的帖子，但我更喜欢C++/Python，但截至发帖时还没有一个公认的答案

---

我的问题：

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;

我对Windows系统内部构件的Mark Russinovich提供的功能在Delphi中的可能实现感兴趣

引述：

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

多谢各位

---

编辑：

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;

---

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

在Windows中没有

SuspendProcess

API调用。因此，您需要做的是：

枚举进程中的所有线程。有关示例代码，请参见

调用这些线程中的每一个

为了实现程序的恢复部分，调用每个线程

---

您可以尝试使用以下代码。它使用未记录的函数

NtSuspendProcess

和

NtResumeProcess

。我已经在Windows7上试用了64位的Delphi2009内置的32位应用程序，它适合我。请注意，这些函数没有文档记录，因此可以从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;

类型
NTSTATUS=LongInt；
TProcFunction=函数（ProcHandle:THandle）：NTSTATUS；stdcall；
常数
STATUS_SUCCESS=$00000000；
进程暂停恢复=0800美元；
函数SuspendProcess（常量PID:DWORD）：布尔值；
变量
LibHandle:THandle；
前柄：坦德尔；
NtSuspendProcess:TProcFunction；
开始
结果：=假；
LibHandle:=SafeLoadLibrary（'ntdll.dll'）；
如果LibHandle为0，则
尝试
@NtSuspendProcess:=GetProcAddress（LibHandle，'NtSuspendProcess'）；
如果@NtSuspendProcess nil，则
开始
ProcHandle:=OpenProcess（进程\挂起\恢复，False，PID）；
如果ProcHandle为0，则
尝试
结果：=NtSuspendProcess（ProcHandle）=状态\成功；
最后
闭合手柄（ProcHandle）；
结束；
结束；
最后
免费图书馆（LibHandle）；
结束；
结束；
函数恢复过程（常量PID:DWORD）：布尔值；
变量
LibHandle:THandle；
前柄：坦德尔；
NtResumeProcess:TProcFunction；
开始
结果：=假；
LibHandle:=SafeLoadLibrary（'ntdll.dll'）；
如果LibHandle为0，则
尝试
@NtResumeProcess:=GetProcAddress（LibHandle，'NtResumeProcess'）；
如果@NtResumeProcess nil，则
开始
ProcHandle:=OpenProcess（进程\挂起\恢复，False，PID）；
如果ProcHandle为0，则
尝试
结果：=NtResumeProcess（ProcHandle）=状态\成功；
最后
闭合手柄（ProcHandle）；
结束；
结束；
最后
免费图书馆（LibHandle）；
结束；
结束；

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

函数ResumeProcess（ProcessID:DWORD）：布尔值；
变量
快照，cThr:DWORD；
ThrHandle:THandle；
线程：TThreadEntry32；
开始
结果：=假；
cThr:=GetCurrentThreadId；
快照：=CreateToolhelp32Snapshot（TH32CS\u SNAPTHREAD，0）；
如果快照句柄值无效，则
开始
Thread.dwSize:=SizeOf（TThreadEntry32）；
如果先执行线程32（快照、线程），则
重复
如果（Thread.th32ThreadID cThr）和（Thread.th32OwnerProcessID=ProcessID），则
开始
ThrHandle:=OpenThread（THREAD\u ALL\u ACCESS，false，THREAD.th32ThreadID）；
如果ThrHandle=0，则退出；
恢复线程（ThrHandle）；
关闭手柄（ThrHandle）；
结束；
直到不是下一个线程（快照、线程）；
结果：=CloseHandle（快照）；
结束；
结束；

---

暂停进程：

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;

函数SuspendProcess（PID:DWORD）：布尔值；
变量
hSnap:THandle；
THR32:THREADENTRY32；
霍本：坦德尔；
开始
结果：=假；
hSnap:=CreateToolhelp32Snapshot（TH32CS\u SNAPTHREAD，0）；
如果hSnap无效\u句柄\u值，则
开始
THR32.dwSize:=SizeOf（THR32）；
螺纹32优先（hSnap，THR32）；
重复
如果THR32.th32OwnerProcessID=PID，则
开始
hOpen:=OpenThread（$0002，FALSE，THR32.th32ThreadID）；
如果hOpen的句柄值无效，则
开始
结果：=真；
悬置螺纹（霍本）；
闭柄（霍本）；
结束；
结束；
直到Thread32Next（hSnap，THR32）=FALSE；
闭合手柄（hSnap）；
结束；
结束；

---

免责声明：

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;

---

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

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

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

---

未记录的函数可避免此问题。

是否要模拟整个功能？远程进程吗？现在这是一个非常好的（x3）question@David海夫南：不，让我们放弃远程功能。这似乎是合理的模拟功能。基于pssupend的使用，我怀疑未记录的API:

pssupend[-][-r][\\computer[-u username][-p password]]

。有没有办法确定它没有任何用处