[Delphi] DH Auto Clicker 0.6

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

Tema anterior - Siguiente tema

0 Miembros y 2 Visitantes 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 :

    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.