Процесс-киллер на Delphi

[waldemar80]

Есть ли у кого пример написания менеджера процессов на Delphi с использованием функций из ntdll.dll, или хотябы линки по теме?

[Ragimovich]

http://www.wasm.ru/author.php?author=Ms-Rem

Это единственный, кто низкоуровневым программированием занимается на делфи. Изврат одним словом;-)

[wellwisher]

Ragimovich,

Цитата: Сообщение от Ragimovich Это единственный, кто низкоуровневым программированием занимается на делфи. Изврат одним словом

Далеко не единственный Какая разница на чем писать Delphi так Delphi.
waldemar80, получи (Убебей для начала нотепад):

Цитата: uses Tlhelp32; function KillTask(ExeFileName: string): Integer; const PROCESS_TERMINATE = $0001; var ContinueLoop: BOOL; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32; begin Result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); while Integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeF ile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then Result := Integer(TerminateProcess( OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0)); ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; procedure TForm1.Button1Click(Sender: TObject); begin KillTask('notepad.exe'); end; { For Windows NT/2000/XP } procedure KillProcess(hWindowHandle: HWND); var hprocessID: INTEGER; processHandle: THandle; DWResult: DWORD; begin SendMessageTimeout(hWindowHandle, WM_CLOSE, 0, 0, SMTO_ABORTIFHUNG or SMTO_NORMAL, 5000, DWResult); if isWindow(hWindowHandle) then begin // PostMessage(hWindowHandle, WM_QUIT, 0, 0); { Get the process identifier for the window} GetWindowThreadProcessID(hWindowHandle, @hprocessID); if hprocessID <> 0 then begin { Get the process handle } processHandle := OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION, False, hprocessID); if processHandle <> 0 then begin { Terminate the process } TerminateProcess(processHandle, 0); CloseHandle(ProcessHandle); end; end; end; end; procedure TForm1.Button2Click(Sender: TObject); begin KillProcess(FindWindow('notepad',nil)); end;

[Ruzzz]

Помоему на Delphi тоже можна многое, были бы unitы нужные да мозги

[f0w14]

Цитата: Сообщение от waldemar80 Есть ли у кого пример написания менеджера процессов на 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

[Lightsoft]

Могу предложить мою софтину, которая умеет завершать любой процесс без исключения. E-Mail: Lightsoft92@mail.ru

[hack]

Цитата: Сообщение от Lightsoft Могу предложить мою софтину

Так выкладывайте на форуме, а торговать - извольте идти на рынок.

[7OH]

А как убить, допустим, "c:\program files\notepad.exe" у которого в ярлыке прописано, запускаться в рабочем каталоге "D:\1" ?

Добавлено через 1 минуту
Интересует почему - есть программа, которая для разных пользователей может быть запущена в нескольких экземлярах и при этом в разных рабочих каталогах.