Ответ: Процесс-киллер на Delphi
Цитата:
Сообщение от waldemar80
(Сообщение 1220622)
Есть ли у кого пример написания менеджера процессов на Delphi с использованием функций из ntdll.dll, или хотябы линки по теме?
|
Линк по теме: убиватель процессов. :)
Код:
program KillProc;
{$R 'KillProc.res' 'KillProc.rc'}
uses
Windows,
SysUtils,
PSAPI,
TlHelp32;
type
TLpModuleInfo = record
PID: Cardinal;
Name: String;
end;
TLpModuleInfoArray = array of TLpModuleInfo;
const
CRLF = #13#10;
CPARAMHELP = '-?';
CPARAMSHOWPROCS = '-l';
CPARAMKILLBYPATH = '-p';
CPARAMKILLBYEXE = '-n';
CPARAMSILENCE = '-s';
CPARAMKILLBYHANDLE = '-h';
CPARAMDELAY = '-d';
CINFO = 'Убийца процессов. f0w14''s stuff' + CRLF +
'Используйте ключи:' + CRLF +
CPARAMHELP + ' - это сообщение' + CRLF +
CPARAMSHOWPROCS + ' - отобразить список процессов' + CRLF +
CPARAMKILLBYPATH + ' <путь\имя файла> - убить все процессы с указанным путем и именем файла' + CRLF +
CPARAMKILLBYEXE + ' <ключевое слово> - убить все процессы с указанным словом в имени файла' + CRLF +
CPARAMKILLBYHANDLE + ' <PID> - убить процесс с указанным PID' + CRLF +
CPARAMSILENCE + ' - убивать процесс без подтверждения' + CRLF +
CPARAMDELAY + ' <число> пауза в мСек после запуска программы перед убиванием процесов' + CRLF +
'ВНИМАНИЕ! ПРОЦЕСС БУДЕТ УБИТ БЕЗ УВЕДОМЛЕНИЯ! МОГУТ БЫТЬ ПОТЕРЯНЫ ДАННЫЕ';
CUNKNOWN = 'Неизвестный ключ %s. Используйте параметр ' + CPARAMHELP + ' для информации';
CKILLERR = 'Не удалось убить процесс ';
CASKKILL = 'Убить процесс %s?';
procedure MsgErr(const S: String);
begin
MessageBox(0, PChar(S), nil, MB_OK or MB_ICONSTOP);
end;
procedure MsgInfo(const S: String);
begin
MessageBox(0, PChar(S), 'Внимание', MB_OK or MB_ICONINFORMATION);
end;
function MsgAsk(const S: String): Boolean;
begin
Result:= MessageBox(0, PChar(S), 'Подтверждение', MB_YESNO or MB_ICONQUESTION) = IDYES;
end;
function GetErrStr(Error: Integer): String;
var
Buf: PChar;
begin
Result:= '';
GetMem(Buf, MAX_PATH);
try
ZeroMemory(Buf, MAX_PATH);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, Error, 0, Buf, MAX_PATH - 1, nil);
Result:= Buf;
finally
Freemem(Buf);
end;
end;
function KillProcess(PID: Integer): Integer;
var
PH, EC: Cardinal;
begin
Result:= 0;
PH:= OpenProcess(PROCESS_ALL_ACCESS, True, PID);
GetExitCodeProcess(PH, EC);
if (PH = 0) then
Result:= GetLastError
else begin
if not TerminateProcess(PH, EC) then
Result:= GetLastError;
CloseHandle(PH);
end;
end;
function GetProcessInfo(PID: WORD): LPMODULEINFO;
var
hProc: Cardinal;
hMod: HMODULE;
CM: Cardinal;
begin
hProc:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
New(Result);
ZeroMemory(Result, SizeOf(Result^));
if hProc <> 0 then begin
EnumProcessModules(hProc, @hMod, 4, CM);
GetModuleInformation(hProc, hMod, Result, SizeOf(Result^));
end;
end;
function GetAllProcessesInfo: TLpModuleInfoArray;
var
ProcList: array[0..$FFF] of Cardinal;
CM: Cardinal;
I: WORD;
ModName: array[0..MAX_PATH] of Char;
PH, MH: THandle;
SnapShot: THandle;
ProcEntry: TProcessEntry32;
begin
Result:= nil;
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then begin
SnapShot:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Integer(SnapShot) <> -1 then begin
ZeroMemory(@ProcEntry, SizeOf(ProcEntry));
ProcEntry.dwSize:= SizeOf(TProcessEntry32);
if Process32First(SnapShot, ProcEntry) then begin
I:= 1;
while Process32Next(SnapShot, ProcEntry) do
Inc(I);
SetLength(Result, I);
I:= Low(Result);
if Process32First(SnapShot, ProcEntry) then
repeat
Result[I].PID:= ProcEntry.th32ProcessID;
Result[I].Name:= ProcEntry.szExeFile;
Inc(I);
until not Process32Next(SnapShot, ProcEntry);
end;
end;
end
else begin
EnumProcesses(@ProcList, SizeOf(ProcList), CM);
SetLength(Result, CM shr 2);
for I:= Low(Result) to High(Result) do
case ProcList[I] of
0:
begin
Result[I].Name:= 'Бездействие системы';
Result[I].PID:= 0;
end;
4, 8:
begin
Result[I].Name:= 'System';
Result[I].PID:= ProcList[I];
end;
else begin
Result[I].PID:= ProcList[I];
PH:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcList[I]);
if PH > 0 then begin
EnumProcessModules(PH, @MH, 4, CM);
GetModuleFileNameEx(PH, MH, @ModName[0], SizeOf(ModName));
Result[I].Name:= ModName;
end
else
Result[I].Name:= 'неизвестно';
CloseHandle(PH);
end;
end;
end;
end;
procedure DisposeProcessesInfo(var ProcArr: TLpModuleInfoArray);
begin
SetLength(ProcArr, 0);
end;
var
ProcArr: TLpModuleInfoArray = nil;
bKillExe, bKillName, bKillHandle, bSilence, bPause: Boolean;
sExe, sPath: String;
iPause, iHandle: Cardinal;
procedure ShowProcessList;
const
CPROCITEMS = 30;
var
I, J, K: Integer;
S: String;
begin
ProcArr:= GetAllProcessesInfo;
try
I:= Low(ProcArr);
J:= (High(ProcArr) div CPROCITEMS) + 1;
while J > 0 do begin
S:= '';
for K:= 0 to (High(ProcArr) div J) do begin
if I > High(ProcArr) then
Break;
S:= S + CRLF + Format('%.6d %s', [ProcArr[I].PID, ProcArr[I].Name]);
Inc(I);
end;
MsgInfo('Список процессов' + S);
Dec(J);
end;
finally
DisposeProcessesInfo(ProcArr);
end;
end;
procedure ParseParams;
var
I: Integer;
begin
I:= 1;
bKillExe:= False;
bKillName:= False;
bKillHandle:= False;
bSilence:= False;
bPause:= False;
while I <= ParamCount do begin
if AnsiCompareText(ParamStr(I), CPARAMHELP) = 0 then begin
MsgInfo(CINFO);
Exit;
end
else
if AnsiCompareText(ParamStr(I), CPARAMSHOWPROCS) = 0 then begin
ShowProcessList;
Exit;
end
else
if AnsiCompareText(ParamStr(I), CPARAMDELAY) = 0 then begin
if I >= ParamCount then begin
MsgErr('Не указана задержка!');
Exit;
end;
Inc(I);
try
iPause:= StrToInt(ParamStr(I));
except
MsgErr('Неверное число задержки, мсек: ' + ParamStr(I));
Exit;
end;
bPause:= True;
end
else
if AnsiCompareText(ParamStr(I), CPARAMKILLBYHANDLE) = 0 then begin
if I >= ParamCount then begin
MsgErr('Не указан хендл процесса!');
Exit;
end;
Inc(I);
try
iHandle:= StrToInt(ParamStr(I));
except
MsgErr('Неверный хендл процесса: ' + ParamStr(I));
Exit;
end;
bKillHandle:= True;
end
else
if AnsiCompareText(ParamStr(I), CPARAMSILENCE) = 0 then
bSilence:= True
else
if AnsiCompareText(ParamStr(I), CPARAMKILLBYPATH) = 0 then begin
if I >= ParamCount then begin
MsgErr('Не указаны путь\имя файла!');
Exit;
end;
Inc(I);
sPath:= ParamStr(I);
bKillName:= True;
end
else
if AnsiCompareText(ParamStr(I), CPARAMKILLBYEXE) = 0 then begin
if I >= ParamCount then begin
MsgErr('Не указано ключевое слово!');
Exit;
end;
Inc(I);
sExe:= ParamStr(I);
bKillExe:= True;
end
else begin
MsgErr(Format(CUNKNOWN, [ParamStr(I)]));
Exit;
end;
Inc(I);
end;
end;
var
I, J: Integer;
S: String;
C: Cardinal;
begin
if ParamCount = 0 then begin
MsgInfo(CINFO);
Exit;
end;
ParseParams;
if not (bKillExe or bKillHandle or bKillName) then
Exit;
if bPause and (iPause > 0) then begin
C:= GetTickCount;
repeat
Sleep(10);
until (GetTickCount - C) > iPause;
end;
ProcArr:= GetAllProcessesInfo;
try
if bKillName then begin
for I:= Low(ProcArr) to High(ProcArr) do
if AnsiCompareText(ProcArr[I].Name, sPath) = 0 then begin
S:= Format('%.6d %s', [ProcArr[I].PID, ProcArr[I].Name]);
if bSilence or MsgAsk(Format(CASKKILL, [S])) then begin
J:= KillProcess(ProcArr[I].PID);
if (J <> 0) and not bSilence then
MsgErr(CKILLERR + S + CRLF + GetErrStr(J));
end;
end;
Exit;
end;
if bKillExe then begin
for I:= Low(ProcArr) to High(ProcArr) do begin
ProcArr[I].Name:= AnsiUpperCase(ExtractFileName(ProcArr[I].Name));
sExe:= AnsiUpperCase(sExe);
S:= Format('%.6d %s', [ProcArr[I].PID, ProcArr[I].Name]);
if Pos(sExe, ProcArr[I].Name) > 0 then
if bSilence or MsgAsk(Format(CASKKILL, [S])) then begin
J:= KillProcess(ProcArr[I].PID);
if (J <> 0) and not bSilence then
MsgErr(CKILLERR + S + CRLF + GetErrStr(J));
end;
end;
Exit;
end;
if bKillHandle then
for I:= Low(ProcArr) to High(ProcArr) do
if ProcArr[I].PID = iHandle then begin
S:= Format('%.6d %s', [ProcArr[I].PID, ProcArr[I].Name]);
if bSilence or MsgAsk(Format(CASKKILL, [S])) then begin
J:= KillProcess(ProcArr[I].PID);
if (J <> 0) and not bSilence then
MsgErr(CKILLERR + S + CRLF + GetErrStr(J));
end;
end;
finally
DisposeProcessesInfo(ProcArr);
end;
end.
УБИВЕЦ ПРОЦЕССОВ W9X/NT. :)
by Ilya Katargin // ACG aka f0w14 2007
Убивает процесс по заданному пути\имени файла, ключевому слову в имени файла или по PID процесса.
Порядок следования параметров значения не имеет.
Пример использования:
killproc -?
Вывести подсказку
killproc -l
Вывести список всех процессов
killproc -s -h 12345
Убить процесс с PID 12345 без запроса подтверждения.
killproc -n notepad
Убить все процессы, в имени файлов которых есть слово notepad. Это и notepad.exe, и mynotepadprog.exe и т.д. Будет запрошено подтверждение.
killproc -s -p "c:\program files\notepad.exe"
Убить все процессы блокнота, запущенного из каталога program files без подтверждения. Блокнот, запущенный из c:\windows\system32\notepad.exe останется. Кавычки нужны чтобы программа обработала путь с пробелом не как два параметра, а как один.
killproc -d 3000 -n excel -s
Выждать паузу 3 секунды после запуска и затем убить все окна экселя без подтверждения.
have a fun |
