Suspender/reanudar procesos como PsSuspend hace

Question

Espero que esta publicación no sea una duplicada. Permítanme explicar:

He considerado la publicación similar How to pause/resume any external process under Windows? pero con preferencia de C++/Python y aún sin una respuesta aceptada a partir del momento de la publicación.

---

Mi Pregunta:

Estoy interesado en una posible aplicación en Delphi de la funcionalidad proporcionada por PsSuspendpor Mark Russinovich de Windows Sysinternals .

Cotizaciones:

PsSuspend le permite suspender los procesos en el sistema local o remoto, que es deseable en los casos en que un proceso está consumiendo un recurso (por ejemplo, la red, la CPU o disco) que desea para permitir el uso de diferentes procesos . En lugar de eliminar el proceso que está consumiendo el recurso, la suspensión de le permite dejar que continúe funcionando más tarde en .

Gracias.

---

Editar:

una implementación parcial va a hacer. La capacidad remota se puede eliminar.

Answer 1

Puede intentar utilizar el siguiente código. Utiliza las funciones no documentadas NtSuspendProcess y NtResumeProcess. Lo probé en Windows 7 de 64 bits desde la aplicación de 32 bits creada en Delphi 2009 y funciona para mí. Tenga en cuenta que estas funciones no están documentadas, por lo que se pueden eliminar de futuras versiones de Windows.

actualización

Los SuspendProcess y envoltorios de ResumeProcess el siguiente código son ahora funciones y devuelve True si tiene éxito, False en caso contrario.

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

No hay llamada de API SuspendProcess en Windows. Entonces lo que necesita hacer es:

1. Enumerar todos los hilos en el proceso. Ver RRUZ's answer para el código de muestra.
2. Llame al SuspendThread para cada uno de estos hilos.
3. Para implementar la parte de reanudar del programa, llame al ResumeThread para cada subproceso.

Answer 3

acabo de encontrar los siguientes fragmentos here (Autor: steve10120).

Creo que son objetos valiosos y no puedo evitar publicarlos también como una respuesta alternativa a mi propia pregunta. Proceso

---

CV:

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; 

---

Suspender proceso:

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; 

---

Descargo de responsabilidad:

No los probé en absoluto. Por favor, disfrute y no se olvide de comentarios.

Answer 4

Hay una condición de carrera para la implementación de "suspender todos los hilos": ¿qué ocurre si el programa que está intentando suspender crea uno o más hilos entre el momento en que crea la instantánea y el tiempo que suspende?

Puede repetir el ciclo, obtener otra instantánea y suspender cualquier subproceso que no se suspenda, salir solo cuando no encuentre ninguno.

La función no documentada evita este problema.