Как завершить задачу в 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