Приостановить/возобновить процессы, как PsSuspend

Я надеюсь, что этот пост не является дубликатом. Позвольте мне объяснить:

Я рассмотрел аналогичный пост Как приостановить/возобновить любой внешний процесс под Windows?, но с предпочтением С++/Python и все же без принятого ответа с момента времени публикации.

Мой вопрос:

Меня интересует возможная реализация в Delphi функциональности, предоставляемой PsSuspend от Марка Руссиновича из Windows Sysinternals.

Котировки:

PsSuspend позволяет приостанавливать процессы в локальной или удаленной системе, что желательно в тех случаях, когда процесс потребляет ресурс (например, сеть, центральный процессор или диск), которые вы хотите разрешить для разных процессов использовать. Вместо того, чтобы убивать процесс, который потребляет ресурс, приостановка разрешает вам продолжить работу в несколько последующих момент времени.

Спасибо.

Edit:

Будет выполнена частичная реализация. Удаленные возможности можно отбросить.

Ответ 1

Вы можете попробовать использовать следующий код. Он использует недокументированные функции NtSuspendProcess и NtResumeProcess. Я пробовал его на 64-разрядной версии Windows 7 из 32-разрядного приложения, встроенного в Delphi 2009, и он работает для меня. Обратите внимание, что эти функции недокументированы, поэтому их можно удалить из будущих версий 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;

Ответ 2

В Windows нет вызова SuspendProcess API. Итак, что вам нужно сделать:

Перечислить все потоки процесса. См. ответ RRUZ для примера кода.
Вызовите SuspendThread для каждого из этих потоков.
Чтобы реализовать возобновленную часть программы, вызовите ResumeThread для каждого потока.

Ответ 3

Существует условие гонки для реализации "suspend all threads" - что произойдет, если программа, которую вы пытаетесь приостановить, создает один или несколько потоков между моментом создания моментального снимка и временем, которое вы приостановили?

Вы можете зацикливаться, получить еще один снимок и приостановить любые нерегулярные потоки, выходящие только тогда, когда вы его не нашли.

Недокументированная функция позволяет избежать этой проблемы.

Ответ 4

Я только что нашел следующие фрагменты здесь (Автор: 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;

Отказ от ответственности:

Я не тестировал их вообще. Пожалуйста, наслаждайтесь и не забывайте обратную связь.