[Delphi] DH Auto Clicker 0.6

Un programa en Delphi para usar un clicker automatico para juegos o lo que sea.

Opciones :

• Capturar posicion del mouse para usar en el programa
• Timeout para cada click
• Teclas de acceso rapido para empezar y terminar el clicker
• Clicks en posiciones aleatorias
• Los Clicks que permite son izquierda,medio,derecha y doble click

Una imagen :



El codigo :

// DH Auto Clicker 0.6
// (C) Doddy Hackman 2016

unit auto_clicker;

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, Math, Vcl.ImgList, Vcl.Imaging.pngimage;

type
  TFormHome = class(TForm)
    logo: TImage;
    gbMousePosition: TGroupBox;
    lblXPosition: TLabel;
    txt_X_Now: TEdit;
    lblYPosition: TLabel;
    txt_Y_Now: TEdit;
    gbOptions: TGroupBox;
    lblType: TLabel;
    cmbType: TComboBox;
    lblSleep: TLabel;
    txtSleep: TEdit;
    lblXSelect: TLabel;
    txt_X_Select: TEdit;
    lblYSelect: TLabel;
    txt_Y_Select: TEdit;
    lblSeconds: TLabel;
    btnGetPosition: TButton;
    cbUseRandomClicks: TCheckBox;
    btnStart: TButton;
    btnStop: TButton;
    status: TStatusBar;
    tmGetMousePosition: TTimer;
    tmClicker: TTimer;
    notificar: TTrayIcon;
    tmHookKeys: TTimer;
    ilIconos: TImageList;
    procedure tmGetMousePositionTimer(Sender: TObject);
    procedure btnGetPositionClick(Sender: TObject);
    procedure tmClickerTimer(Sender: TObject);
    procedure notificarClick(Sender: TObject);
    procedure tmHookKeysTimer(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure capturar_posicion_mouse();
    procedure iniciar_clicker();
    procedure desactivar_clicker();
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}

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;

procedure mouse_click(option: string);
// Function based in : http://www.swissdelphicenter.ch/torry/showcode.php?id=360
// Thanks to Thomas Stutz
begin
  if (option = 'left') then
  begin
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
  end
  else if (option = 'right') then
  begin
    mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
  end
  else if (option = 'middle') then
  begin
    mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0);
  end
  else if (option = 'double') then
  begin
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
    GetDoubleClickTime;
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
  end
  else
  begin
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
  end;
end;

procedure TFormHome.iniciar_clicker();
begin
  if (cmbType.ItemIndex <> -1) and not(txt_X_Select.Text = '') and
    not(txt_Y_Select.Text = '') and not(txtSleep.Text = '') then
  begin
    tmClicker.Interval := StrToInt(txtSleep.Text) * 1000;
    tmClicker.Enabled := True;
    status.Panels[0].Text := '[+] Working ...';
    FormHome.Update;
    notificar.BalloonTitle := 'DH Auto Clicker';
    notificar.BalloonHint := 'Clicker Started';
    notificar.ShowBalloonHint;
  end
  else
  begin
    message_box('DH Auto Clicker 0.6', 'Complete the options', 'Warning');
  end;
end;

procedure TFormHome.desactivar_clicker();
begin
  tmClicker.Enabled := False;
  status.Panels[0].Text := '[+] Stopped';
  FormHome.Update;
  notificar.BalloonTitle := 'DH Auto Clicker';
  notificar.BalloonHint := 'Clicker Stopped';
  notificar.ShowBalloonHint;
end;

procedure TFormHome.btnStartClick(Sender: TObject);
begin
  iniciar_clicker();
end;

procedure TFormHome.btnStopClick(Sender: TObject);
begin
  desactivar_clicker();
end;

procedure TFormHome.capturar_posicion_mouse();
begin
  txt_X_Select.Text := txt_X_Now.Text;
  txt_Y_Select.Text := txt_Y_Now.Text;
  status.Panels[0].Text := '[+] Position updated';
  FormHome.Update;
  notificar.BalloonTitle := 'DH Auto Clicker';
  notificar.BalloonHint := 'Position updated';
  notificar.ShowBalloonHint;
end;

procedure TFormHome.notificarClick(Sender: TObject);
begin
  Show();
  WindowState := wsNormal;
  Application.BringToFront();
end;

procedure TFormHome.btnGetPositionClick(Sender: TObject);
begin
  capturar_posicion_mouse();
end;

procedure TFormHome.tmGetMousePositionTimer(Sender: TObject);
var
  ubicacion: tPoint;
begin
  ubicacion := Mouse.CursorPos;
  txt_X_Now.Text := IntToStr(ubicacion.X);
  txt_Y_Now.Text := IntToStr(ubicacion.Y);
end;

procedure TFormHome.tmHookKeysTimer(Sender: TObject);
var
  i: integer;
  re: Longint;
begin
  for i := 119 to 124 do
  begin
    re := GetAsyncKeyState(i);
    If re = -32767 then
    Begin
      if (i = 120) then
      begin
        capturar_posicion_mouse();
      end
      else if (i = 122) then
      begin
        iniciar_clicker();
      end
      else if (i = 123) then
      begin
        desactivar_clicker();
      end
      else
      begin
        // ?
      end;
    End;
  End;
end;

procedure TFormHome.tmClickerTimer(Sender: TObject);
var
  tipo: integer;
  nombre_tipo: string;
  X: integer;
  Y: integer;
  time_sleep: integer;
begin

  tipo := cmbType.ItemIndex;
  nombre_tipo := '';

  if (tipo = 0) then
  begin
    nombre_tipo := 'left';
  end
  else if (tipo = 1) then
  begin
    nombre_tipo := 'middle';
  end
  else if (tipo = 2) then
  begin
    nombre_tipo := 'right';
  end
  else if (tipo = 3) then
  begin
    nombre_tipo := 'double';
  end
  else
  begin
    nombre_tipo := 'left';
  end;

  X := 0;
  Y := 0;

  if (cbUseRandomClicks.Checked) then
  begin
    X := RandomRange(1, 2000);
    Y := RandomRange(1, 1000);
  end
  else
  begin
    X := StrToInt(txt_X_Select.Text);
    Y := StrToInt(txt_Y_Select.Text);
  end;

  time_sleep := StrToInt(txtSleep.Text) * 1000;

  SetCursorPos(X, Y);

  mouse_click(nombre_tipo);

end;

end.

// The End ?

Si quieren bajar el programa y el proyecto con el codigo fuente lo pueden hacer desde aca :

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

Eso seria todo.