Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как завершить задачу в Windows NT (а заодно получить PID задачи)?

01.01.2007

Ниже приведён unit, который позволяет убить задачу в Windows NT.

Entry :

 
function Kill_By_Pid(pid : longint) : integer; 
  где pid, это число, представляющее pid задачи
 
function EnumProcessWithPid(list : TStrings) : integer; 
  где список, это объект TStrings, который будет содержать имя задачи и pid в полях Object.
  ( list.Items[i] для имени, integer(list.Object[i]) для PID) 

Дальше следует сам код:

procedure GenerateBlueScreen; 
var 
  Task : TStringList; 
  i : integer; 
begin 
  Task := TStringList.Create; 
  Try 
    EnumProcessWithPid(Task); 
    for i := 0 to Task.Count - 1 do 
    begin 
      TaskName := UpperCase(Task[i]); 
      if (TaskName = 'WINLOGON.EXE') then 
      begin // Generate a nice BlueScreenOfDeath 
        Kill_By_Pid(integer(Task.Objects[i])); 
        Beep; 
        break; 
      end; 
    end; 
  Finally 
    Task.Free; 
  end; 
end; 
unit U_Kill; 
{** JF 15/02/2000 - U_Kill.pas 
** This unit allow you to list and to kill runnign process. (Work only on NT) 
** Entry point : EnumProcessWithPid and Kill_By_Pid. 
** v1.2 JF correct a bug in Kill_By_Pid 
** v1.3 JF change a thing for D5 05/09/2000 
**} 
interface 
 
uses 
Classes; 
 
//** Error code **// 
const 
KILL_NOERR = 0; 
KILL_NOTSUPPORTED = -1; 
KILL_ERR_OPENPROCESS = -2; 
KILL_ERR_TERMINATEPROCESS = -3; 
 
ENUM_NOERR = 0; 
ENUM_NOTSUPPORTED = -1; 
ENUM_ERR_OPENPROCESSTOKEN = -2; 
ENUM_ERR_LookupPrivilegeValue = -3; 
ENUM_ERR_AdjustTokenPrivileges = -4; 
 
GETTASKLIST_ERR_RegOpenKeyEx = -1; 
GETTASKLIST_ERR_RegQueryValueEx = -2; 
 
function Kill_By_Pid(pid : longint) : integer; 
function EnumProcessWithPid(list : TStrings) : integer; 
 
implementation 
uses 
  Windows, 
  Registry, 
  SysUtils; 
var 
  VerInfo : TOSVersionInfo; 
const 
  SE_DEBUG_NAME = 'SeDebugPrivilege'; 
  INITIAL_SIZE  =     51200; 
  EXTEND_SIZE   =     25600; 
  REGKEY_PERF   =     'software\microsoft\windows nt\currentversion\perflib'; 
  REGSUBKEY_COUNTERS ='Counters'; 
  PROCESS_COUNTER    ='process'; 
  PROCESSID_COUNTER  ='id process'; 
  UNKNOWN_TASK       ='unknown'; 
type 
  ArrayOfChar = array[0..1024] of char; 
  pArrayOfChar = ^pArrayOfChar; 
type 
  TPerfDataBlock = record 
    Signature       : array[0..3] of WCHAR; 
    LittleEndian    : DWORD; 
    Version         : DWORD; 
    Revision        : DWORD; 
    TotalByteLength : DWORD; 
    HeaderLength    : DWORD; 
    NumObjectTypes  : DWORD; 
    DefaultObject   : integer; 
    SystemTime      : TSystemTime; 
    PerfTime        : TLargeInteger; 
    PerfFreq        : TLargeInteger; 
    PerfTime100nSec : TLargeInteger; 
    SystemNameLength: DWORD; 
    SystemNameOffset: DWORD; 
  end; 
  pTPerfDataBlock = ^TPerfDataBlock; 
  TPerfObjectType = record 
    TotalByteLength    : DWORD; 
    DefinitionLength   : DWORD; 
    HeaderLength       : DWORD; 
    ObjectNameTitleIndex : DWORD; 
    ObjectNameTitle    : LPWSTR; 
    ObjectHelpTitleIndex : DWORD; 
    ObjectHelpTitle      : LPWSTR; 
    DetailLevel          : DWORD; 
    NumCounters          : DWORD; 
    DefaultCounter       : integer; 
    NumInstances         : integer; 
    CodePage             : DWORD; 
    PerfTime             : TLargeInteger; 
    PerfFreq             : TLargeInteger; 
  end; 
  pTPerfObjectType       = ^TPerfObjectType; 
  TPerfInstanceDefinition = record 
     ByteLength           : DWORD; 
     ParentObjectTitleIndex : DWORD; 
     ParentObjectInstance   : DWORD; 
     UniqueID               : integer; 
     NameOffset             : DWORD; 
     NameLength             : DWORD; 
  end; 
  pTPerfInstanceDefinition = ^TPerfInstanceDefinition; 
 
  TPerfCounterBlock = record 
    ByteLength      : DWORD; 
  end; 
  pTPerfCounterBlock = ^TPerfCounterBlock; 
 
  TPerfCounterDefinition = record 
    ByteLength               : DWORD; 
    CounterNameTitleIndex    : DWORD; 
    CounterNameTitle         : LPWSTR; 
    CounterHelpTitleIndex    : DWORD; 
    CounterHelpTitle         : LPWSTR; 
    DefaultScale             : integer; 
    DetailLevel              : DWORD; 
    CounterType              : DWORD; 
    CounterSize              : DWORD; 
    CounterOffset            : DWORD; 
  end; 
  pTPerfCounterDefinition = ^TPerfCounterDefinition; 
 
procedure InitKill; 
begin 
  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); 
  GetVersionEx(VerInfo); 
end; 
 
(* 
#define MAKELANGID(p, s)       ((((WORD  )(s)) << 10) | (WORD  )(p)) 
*) 
function MAKELANGID(p : DWORD ; s : DWORD) : word; 
begin 
  result := (s shl 10) or (p); 
end; 
 
function Kill_By_Pid(pid : longint) : integer; 
var 
  hProcess : THANDLE; 
  TermSucc : BOOL; 
begin 
  if (verInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then 
  begin 
    hProcess := OpenProcess(PROCESS_ALL_ACCESS, true, pid); 
    if (hProcess = 0) then // v 1.2 : was =-1 
    begin 
      result := KILL_ERR_OPENPROCESS; 
    end 
    else 
    begin 
      TermSucc := TerminateProcess(hProcess, 0); 
      if (TermSucc = false) then 
        result := KILL_ERR_TERMINATEPROCESS 
      else 
        result := KILL_NOERR; 
    end; 
  end 
  else 
    result := KILL_NOTSUPPORTED; 
end; 
 
function  EnableDebugPrivilegeNT : integer; 
var 
  hToken : THANDLE; 
  DebugValue : TLargeInteger; 
  tkp : TTokenPrivileges ; 
  ReturnLength : DWORD; 
  PreviousState: TTokenPrivileges; 
begin 
  if (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) = false) then 
    result := ENUM_ERR_OPENPROCESSTOKEN 
  else 
  begin 
    if (LookupPrivilegeValue(nil, SE_DEBUG_NAME, DebugValue) = false) then 
      result := ENUM_ERR_LookupPrivilegeValue 
    else 
    begin 
      ReturnLength := 0; 
      tkp.PrivilegeCount := 1; 
      tkp.Privileges[0].Luid := DebugValue; 
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; 
      AdjustTokenPrivileges(hToken, false, tkp, SizeOf(TTokenPrivileges),PreviousState , ReturnLength); 
      if (GetLastError <> ERROR_SUCCESS) then 
        result := ENUM_ERR_AdjustTokenPrivileges 
      else 
        result := ENUM_NOERR; 
    end; 
  end; 
end; 
 
function  IsDigit(c : char) : boolean; 
begin 
  result := (c>='0') and (c<='9'); 
end; 
 
function  min(a,b : integer) : integer; 
begin 
  if (a < b) then result := a 
  else result := b; 
end; 
 
function  GetTaskListNT(pTask : TStrings) : integer; 
var 
  rc      : DWORD; 
  hKeyNames : HKEY; 
  dwType    : DWORD; 
  dwSize    : DWORd; 
  buf       : PBYTE; 
  szSubkey  : array[0..1024] of char; 
  lid       : LANGID; 
  p         : PCHAR; 
  p2        : PCHAR; 
  pPerf     : pTPerfDataBlock; 
  pObj      : pTPerfObjectType; 
  pInst     : pTPerfInstanceDefinition; 
  pCounter  : pTPerfCounterBlock; 
  pCounterDef : pTPerfCounterDefinition; 
  i           : DWORD; 
  dwProcessIdTitle : DWORD; 
  dwProcessIdCounter : DWORD; 
  szProcessName : array[0..MAX_PATH] of char; 
  dwLimit       : DWORD; 
  dwNumTasks    : dword; 
 
  ProcessName   : array[0..MAX_PATH] of char; 
  dwProcessID   : DWORD; 
label 
  EndOfProc; 
begin 
  dwNumTasks := 255; 
  dwLimit := dwNumTasks - 1; 
  StrCopy(ProcessName, ''); 
  lid := MAKELANGID(LANG_ENGLISH, SUBLANG_NEUTRAL); 
  StrFmt(szSubKey, '%s\%.3X', [REGKEY_PERF, lid]); 
  rc := RegOpenKeyEx(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_READ, hKeyNames); 
  if (rc <> ERROR_SUCCESS) then 
    result := GETTASKLIST_ERR_RegOpenKeyEx 
  else 
  begin 
    result := 0; 
    rc := RegQueryValueEx(hKeyNames, REGSUBKEY_COUNTERS, nil, @dwType, nil, @dwSize); 
    if (rc <> ERROR_SUCCESS) then 
      result := GETTASKLIST_ERR_RegQueryValueEx 
    else 
    begin 
      GetMem(buf, dwSize); 
      FillChar(buf^, dwSize, 0); 
      RegQueryValueEx(hKeyNames, REGSUBKEY_COUNTERS, nil, @dwType, buf, @dwSize); 
      p := PCHAR(buf); 
      dwProcessIdTitle := 0; 
      while (p^<>#0) do 
      begin 
        if (p > buf) then 
        begin 
          p2 := p - 2; 
          while(isDigit(p2^)) do 
            dec(p2); 
        end; 
        if (StrIComp(p, PROCESS_COUNTER) = 0) then 
        begin 
          p2 := p -2; 
          while(isDigit(p2^)) do 
            dec(p2); 
          strCopy(szSubKey, p2+1); 
        end 
        else 
        if (StrIComp(p, PROCESSID_COUNTER) = 0) then 
        begin 
          p2 := p - 2; 
          while(isDigit(p2^)) do 
            dec(p2); 
           dwProcessIdTitle := StrToIntDef(p2+1, -1); 
        end; 
        p := p + (Length(p) + 1); 
      end; 
      FreeMem(buf); buf := nil; 
      dwSize := INITIAL_SIZE; 
      GetMem(buf, dwSize); 
      FillChar(buf^, dwSize, 0); 
      pPerf := nil; 
      while (true) do 
      begin 
        rc := RegQueryValueEx(HKEY_PERFORMANCE_DATA, szSubKey, nil, @dwType, buf, @dwSize); 
        pPerf := pTPerfDataBlock(buf); 
        if ((rc = ERROR_SUCCESS) and (dwSize > 0) and 
            (pPerf^.Signature[0] = WCHAR('P')) and 
            (pPerf^.Signature[1] = WCHAR('E')) and 
            (pPerf^.Signature[2] = WCHAR('R')) and 
            (pPerf^.Signature[3] = WCHAR('F')) 
            ) then 
        begin 
          break; 
        end; 
        if (rc = ERROR_MORE_DATA) then 
        begin 
          dwSize := dwSize + EXTEND_SIZE; 
          FreeMem(buf); buf := nil; 
          GetMem(buf, dwSize); 
          FillChar(buf^, dwSize, 0);
        end 
        else 
          goto EndOfProc; 
      end; 
 
      pObj := pTPerfObjectType( DWORD(pPerf) + pPerf^.HeaderLength); 
 
      pCounterDef := pTPerfCounterDefinition( DWORD(pObj) + pObj^.HeaderLength); 
      dwProcessIdCounter := 0; 
      i := 0; 
      while (i < pObj^.NumCounters) do 
      begin 
        if (pCounterDef^.CounterNameTitleIndex = dwProcessIdTitle) then 
        begin 
          dwProcessIdCounter := pCounterDEf^.CounterOffset; 
          break; 
        end; 
        inc(pCounterDef); 
        inc(i); 
      end; 
      dwNumTasks := min(dwLimit, pObj^.NumInstances); 
      pInst := PTPerfInstanceDefinition(DWORD(pObj) + pObj^.DefinitionLength); 
 
      i := 0; 
      while ( i < dwNumTasks) do 
      begin 
        p := PCHAR(DWORD(pInst)+pInst^.NameOffset); 
        rc := WideCharToMultiByte(CP_ACP, 0, LPCWSTR(p), -1, szProcessName, SizeOf(szProcessName), nil, nil); 
        {** This is changed for working with D3 and D5 05/09/2000 **} 
        if (rc = 0) then 
          StrCopy(ProcessName, UNKNOWN_TASK) 
        else 
          StrCopy(ProcessName, szProcessName); 
        // Получаем ID процесса
        pCounter := pTPerfCounterBlock( DWORD(pInst) + pInst^.ByteLength); 
        dwProcessId := LPDWORD(DWORD(pCounter) + dwProcessIdCounter)^; 
        if (dwProcessId = 0) then 
          dwProcessId := DWORD(0); 
        pTask.AddObject(ProcessName, TObject(dwProcessID)); 
        pInst := pTPerfInstanceDefinition( DWORD(pCounter) + pCounter^.ByteLength); 
        inc(i); 
      end; 
      result := dwNumTasks; 
    end; 
  end; 
EndOfProc: 
  if (buf <> nil) then 
    FreeMem(buf); 
  RegCloseKey(hKeyNames); 
  RegCloseKey(HKEY_PERFORMANCE_DATA); 
  RegCloseKey(hKeyNames); 
  RegCloseKey(HKEY_PERFORMANCE_DATA); 
end; 
 
function EnumProcessWithPid(list : TStrings) : integer; 
begin 
  if (verInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then 
  begin 
    EnableDebugPrivilegeNT; 
    result := GetTaskListNT(list); 
  end 
  else 
    result := ENUM_NOTSUPPORTED; 
end; 
 
initialization 
  InitKill; 
end.

Взято из https://forum.sources.ru