[Delphi] DH Auto Clicker 0.6

Iniciado por BigBear, Octubre 02, 2016, 03:02:58 PM

Tema anterior - Siguiente tema

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

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 :

    Código: delphi

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

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.