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

Code:

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.