• Fuentes

 #489841  por Doddy
 11 Dic 2016, 01:32
Un programa en Delphi para listar los procesos de Windows y darles muerte si quieren.

Se puede matar procesos por nombre,pid y por hash md5.

Una imagen :

Imagen

El codigo :
// Program : DH Process Killer
// Version : 0.5
// (C) Doddy Hackman 2016

unit ProcessKiller;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.ComCtrls, tlhelp32, PsAPI, Vcl.ImgList, ShellApi, Vcl.Menus,
  Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
  Vcl.Styles.Utils.SysStyleHook,
  Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
  Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips, DH_Tools,
  Vcl.Imaging.pngimage;

type
  TFormHome = class(TForm)
    imgLogo: TImage;
    gbProcessFound: TGroupBox;
    lvProcess: TListView;
    status: TStatusBar;
    pmOpciones: TPopupMenu;
    RefreshList: TMenuItem;
    K1: TMenuItem;
    KillSelected: TMenuItem;
    KillByPID: TMenuItem;
    KillByName: TMenuItem;
    KillByMD5: TMenuItem;
    ilIconos: TImageList;
    ilIconosProcesos: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure RefreshListClick(Sender: TObject);
    procedure KillSelectedClick(Sender: TObject);
    procedure KillByPIDClick(Sender: TObject);
    procedure KillByNameClick(Sender: TObject);
    procedure KillByMD5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure listar_procesos;
    function kill_process(option: string; arg: string): bool;
  end;

type
  TParametros = record
    Handle: Thandle;
    pid_global: DWORD;
  end;

  parametros_globales = ^TParametros;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

// Get path of process

function get_path_by_pid(process_pid: integer): string;
type
  TQueryFullProcessImageName = function(hProcess: Thandle; dwFlags: DWORD;
    lpExeName: PChar; nSize: PDWORD): bool; stdcall;
var
  handle_process: Thandle;
  path_found: array [0 .. MAX_PATH - 1] of Char;
  query: TQueryFullProcessImageName;
  limit: Cardinal;
  code: string;
begin

  code := '';

  try
    begin
      handle_process := OpenProcess(PROCESS_QUERY_INFORMATION or
        PROCESS_VM_READ, False, process_pid);
      if GetModuleFileNameEX(handle_process, 0, path_found, MAX_PATH) <> 0 then
      begin
        code := path_found;
      end
      else if Win32MajorVersion >= 6 then
      begin
        limit := MAX_PATH;
        ZeroMemory(@path_found, MAX_PATH);
        @query := GetProcAddress(GetModuleHandle('kernel32'),
          'QueryFullProcessImageNameW');
        if query(handle_process, 0, path_found, @limit) then
        begin
          code := path_found;
        end;
      end
      else
      begin
        code := '';
      end;
      CloseHandle(handle_process);
    end;
  except
    begin
      //
    end;
  end;

  if (code = '') then
  begin
    code := '--';
  end;

  Result := code;

end;

// Functions to get window title

function EnumWindowsProc(handle_finder: Thandle; parametro: lParam)
  : bool; stdcall;
var
  pid_found: integer;
begin
  Result := True;
  GetWindowThreadProcessId(handle_finder, @pid_found);
  if parametros_globales(parametro).pid_global = pid_found then
  begin
    parametros_globales(parametro).Handle := handle_finder;
    Result := False;
  end;
end;

function get_window_by_pid(pid: integer): string;
var
  parametros: TParametros;
  title: string;
  open_handle: Thandle;

begin

  parametros.pid_global := pid;
  EnumWindows(@EnumWindowsProc, lParam(@parametros));

  repeat

    open_handle := parametros.Handle;
    parametros.Handle := GetParent(open_handle);

    title := '';
    SetLength(title, 255);
    SetLength(title, GetWindowText(open_handle, PChar(title), Length(title)));

    Result := title;

  until parametros.Handle = 0;

end;

procedure TFormHome.KillByMD5Click(Sender: TObject);
var
  argumento: string;
begin
  argumento := InputBox('DH Process Killer 0.5', 'MD5 : ', '');
  if not(argumento = '') then
  begin
    if (kill_process('md5', argumento)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Write MD5', 'Warning');
  end;
  listar_procesos();
end;

procedure TFormHome.KillByNameClick(Sender: TObject);
var
  argumento: string;
begin
  argumento := InputBox('DH Process Killer 0.5', 'Name : ', '');
  if not(argumento = '') then
  begin
    if (kill_process('name', argumento)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Write Name', 'Warning');
  end;
  listar_procesos();
end;

procedure TFormHome.KillByPIDClick(Sender: TObject);
var
  argumento: string;
begin
  argumento := InputBox('DH Process Killer', 'PID : ', '');
  if not(argumento = '') then
  begin
    if (kill_process('pid', argumento)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Write PID', 'Warning');
  end;
  listar_procesos();
end;

procedure TFormHome.KillSelectedClick(Sender: TObject);
var
  process_id: string;
begin
  if not(lvProcess.Itemindex = -1) then
  begin
    process_id := lvProcess.Selected.Caption;
    if (kill_process('pid', process_id)) then
    begin
      message_box('DH Process Killer 0.5', 'Process Killed', 'Information');
    end
    else
    begin
      message_box('DH Process Killer 0.5', 'Error killing process', 'Error');
    end;
  end
  else
  begin
    message_box('DH Process Killer 0.5', 'Select Process', 'Warning');
  end;
  listar_procesos();
end;

function TFormHome.kill_process(option: string; arg: string): bool;
var
  tools: T_DH_Tools;
  loop_run: bool;
  Handle: Thandle;
  process_load: TProcessEntry32;
  resultado: bool;
  check_ok: bool;
  path: string;
  md5_to_check: string;
begin

  resultado := False;

  tools := T_DH_Tools.Create();

  try
    begin
      Handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      process_load.dwSize := SizeOf(process_load);
      loop_run := Process32First(Handle, process_load);

      while integer(loop_run) <> 0 do
      begin

        if (option = 'pid') then
        begin
          if (process_load.th32ProcessID = StrToInt(arg)) then
          begin
            TerminateProcess(OpenProcess(PROCESS_TERMINATE, bool(0),
              process_load.th32ProcessID), 0);
            resultado := True;
            check_ok := True;
            break;
          end;
        end;

        if (option = 'name') then
        begin
          if (ExtractFileName(process_load.szExeFile) = arg) then
          begin
            TerminateProcess(OpenProcess(PROCESS_TERMINATE, bool(0),
              process_load.th32ProcessID), 0);
            resultado := True;
            check_ok := True;
            break;
          end;
        end;

        if (option = 'md5') then
        begin
          path := get_path_by_pid(process_load.th32ProcessID);
          if (FileExists(path)) then
          begin
            md5_to_check := tools.get_file_md5(path);
            if (md5_to_check = arg) then
            begin
              TerminateProcess(OpenProcess(PROCESS_TERMINATE, bool(0),
                process_load.th32ProcessID), 0);
              resultado := True;
              check_ok := True;
              break;
            end;
          end
        end;

        loop_run := Process32Next(Handle, process_load);
      end;
      if not(check_ok = True) then
      begin
        resultado := False;
      end;
      CloseHandle(Handle);
    end;
  except
    begin
      resultado := False;
    end;
  end;

  tools.Free;

  Result := resultado;

end;

//

procedure TFormHome.listar_procesos;
var
  handle_process: Thandle;
  check_process: LongBool;
  process_load: TProcessEntry32;
  lista: TListItem;
  path: string;
  getdata: SHFILEINFO;
  icono: TIcon;
  cantidad: integer;
var
  Handle: Thandle;
  title: string;
  pid: integer;
begin

  cantidad := 0;

  handle_process := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  process_load.dwSize := SizeOf(process_load);
  check_process := Process32First(handle_process, process_load);

  lvProcess.Items.Clear;

  while check_process do
  begin

    Inc(cantidad);

    lista := lvProcess.Items.Add;
    lista.Caption := IntToStr(process_load.th32ProcessID);
    lista.SubItems.Add(process_load.szExeFile);

    path := get_path_by_pid(process_load.th32ProcessID);

    if (FileExists(path)) then
    begin
      SHGetFileInfo(PChar(path), 0, getdata, SizeOf(getdata),
        SHGFI_ICON or SHGFI_SMALLICON);
    end
    else
    begin
      SHGetFileInfo(PChar('C:\Windows\System32\ftp.exe'), 0, getdata,
        SizeOf(getdata), SHGFI_ICON or SHGFI_SMALLICON);
    end;

    icono := TIcon.Create;

    icono.Handle := getdata.hIcon;
    lista.ImageIndex := ilIconosProcesos.AddIcon(icono);

    lista.SubItems.Add(path);

    title := get_window_by_pid(process_load.th32ProcessID);

    if (title = '') then
    begin
      title := '--';
    end;

    lista.SubItems.Add(title);

    DestroyIcon(getdata.hIcon);
    icono.Free;

    check_process := Process32Next(handle_process, process_load);

  end;

  gbProcessFound.Caption := 'Process Found : ' + IntToStr(cantidad);

end;

procedure TFormHome.RefreshListClick(Sender: TObject);
begin
  listar_procesos();
end;

procedure TFormHome.FormCreate(Sender: TObject);
begin
  listar_procesos();
end;

end.

// The End ?
Si quieren bajar el programa lo pueden hacer de aca :

[ Debe registrarse para ver este enlace ].

Eso seria todo.