[Delphi] DH Process Killer 0.5

Iniciado por BigBear, Diciembre 10, 2016, 09:32:50 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

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 :



El codigo :

Código: delphi

// 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 :

You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login.

Eso seria todo.