Ниже приведён unit, который позволяет убить задачу в Windows NT.
Code: |
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) |
Дальше следует сам код:
Code: |
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; |
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. |
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!