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 :

Imagen


El codigo.

Código: Seleccionar todo

// 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 [Enlace externo eliminado para invitados].
Muy buen mailer XD y seria bueno que le colocaras lo de archivos adjuntos y queda full 100%
[code2=masm]"For the honor of a king. And the destiny of a country. All for one."[/code2]
Funcionar no me funciona, pongo bien mi correo de gmail y su pass, pero me da fail, eso si, se me pone pa riba con el tema remember.... que tiempos yuju!!!!!!

Gracias por este momento!! gggg
FSOCIETY
Responder

Volver a “Nuestros Programas”