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;

 State: 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),State , 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.