[Delphi] DH PasteBin Manager 0.2

Iniciado por BigBear, Octubre 18, 2013, 05:44:04 PM

Tema anterior - Siguiente tema

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

Un simple programa en delphi para subir y bajar codigos en pastebin.

Unas imagenes :







Los codigos :

Menu

Código: delphi

// DH PasteBin Manager 0.2
// (C) Doddy Hackman 2013

unit paste;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, IdMultipartFormData, PerlRegEx, sSkinManager, ComCtrls, sStatusBar,
  sGroupBox, sMemo, sButton, sEdit, sLabel, sListBox, acPNG, ExtCtrls;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image1: TImage;
    sGroupBox1: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sButton3: TsButton;
    sButton4: TsButton;

    procedure FormCreate(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure sButton4Click(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses formdown, formup;
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  dir: string;
begin

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

  dir := ExtractFilePath(Application.ExeName) + '/downloads';

  if not(DirectoryExists(dir)) then
  begin
    CreateDir(dir);
  end;

  ChDir(dir);

end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.sButton3Click(Sender: TObject);
begin
  ShowMessage('Contact to lepuke[at]hotmail[com]');
end;

procedure TForm1.sButton4Click(Sender: TObject);
begin
  Form1.Close();
end;

end.

// The End ?


Uploader

Código: delphi

// DH PasteBin Manager 0.2
// (C) Doddy Hackman 2013

unit formup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, sButton, sEdit, sLabel, sGroupBox, acPNG, ExtCtrls,
  ComCtrls, sStatusBar, PerlRegEx, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdMultipartFormData, sMemo;

type
  TForm3 = class(TForm)
    sGroupBox4: TsGroupBox;
    sLabel3: TsLabel;
    sLabel4: TsLabel;
    sEdit3: TsEdit;
    sEdit4: TsEdit;
    sGroupBox5: TsGroupBox;
    sButton3: TsButton;
    sButton4: TsButton;
    sButton5: TsButton;
    Image1: TImage;
    sStatusBar1: TsStatusBar;
    OpenDialog1: TOpenDialog;
    IdHTTP1: TIdHTTP;
    PerlRegEx1: TPerlRegEx;
    sMemo1: TsMemo;
    procedure sButton4Click(Sender: TObject);
    procedure sButton5Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.sButton3Click(Sender: TObject);
var
  datos: TIdMultiPartFormDataStream;
  code: string;
  titulo: string;
  contenido: string;

  archivo: TextFile;
  texto: string;

begin

  titulo := ExtractFileName(sEdit3.Text);

  sMemo1.Lines.Clear;

  AssignFile(archivo, sEdit3.Text);
  Reset(archivo);

  while not Eof(archivo) do
  begin
    ReadLn(archivo, texto);
    sMemo1.Lines.Add(texto);
  end;

  CloseFile(archivo);

  contenido := sMemo1.Lines.Text;

  datos := TIdMultiPartFormDataStream.Create;

  datos.AddFormField('api_dev_key', 'fuck you');
  datos.AddFormField('api_option', 'paste');
  datos.AddFormField('api_paste_name', titulo);
  datos.AddFormField('api_paste_code', contenido);

  sStatusBar1.Panels[0].Text := '[+] Uploading ...';
  Form3.sStatusBar1.Update;

  code := IdHTTP1.Post('http://pastebin.com/api/api_post.php', datos);

  PerlRegEx1.Regex := 'pastebin';
  PerlRegEx1.Subject := code;

  if PerlRegEx1.Match then
  begin
    sStatusBar1.Panels[0].Text := '[+] Done';
    Form3.sStatusBar1.Update;
    sEdit4.Text := code;
  end
  else
  begin
    sStatusBar1.Panels[0].Text := '[-] Error Uploading';
    Form3.sStatusBar1.Update;
  end;

end;

procedure TForm3.sButton4Click(Sender: TObject);
begin
  OpenDialog1.InitialDir := GetCurrentDir;

  if OpenDialog1.Execute then
  begin
    sEdit3.Text := OpenDialog1.FileName;
  end;

end;

procedure TForm3.sButton5Click(Sender: TObject);
begin
  sEdit4.SelectAll;
  sEdit4.CopyToClipboard;
end;

end.

// The End ?


El downloader.

Código: delphi

// DH PasteBin Manager 0.2
// (C) Doddy Hackman 2013

unit formdown;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, sListBox, sButton, sEdit, sLabel, sGroupBox, PerlRegEx,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, acPNG,
  ExtCtrls, ComCtrls, sStatusBar, sMemo, acProgressBar;

type
  TForm2 = class(TForm)
    sGroupBox1: TsGroupBox;
    sGroupBox2: TsGroupBox;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    sEdit1: TsEdit;
    sEdit2: TsEdit;
    sButton1: TsButton;
    sGroupBox3: TsGroupBox;
    sListBox1: TsListBox;
    sButton2: TsButton;
    IdHTTP1: TIdHTTP;
    PerlRegEx1: TPerlRegEx;
    PerlRegEx2: TPerlRegEx;
    Image1: TImage;
    sStatusBar1: TsStatusBar;
    sProgressBar1: TsProgressBar;

    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
  sProgressBar1.Position := AWorkCount;
  sStatusBar1.Panels[0].Text := '[+] Downloading ...';
  Form2.sStatusBar1.Update;
end;

procedure TForm2.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  sProgressBar1.Max := AWorkCountMax;
  sStatusBar1.Panels[0].Text := '[+] Starting download ...';
  Form2.sStatusBar1.Update;
end;

procedure TForm2.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  sProgressBar1.Position := 0;
  sStatusBar1.Panels[0].Text := '[+] Finished';
  Form2.sStatusBar1.Update;
end;

procedure TForm2.sButton1Click(Sender: TObject);
var
  url: string;
  url2: string;
  code: string;
  i: integer;
  viendo: string;
  chau: TStringList;

begin
  //

  chau := TStringList.Create;

  chau.Duplicates := dupIgnore;
  chau.Sorted := True;
  chau.Assign(sListBox1.Items);
  sListBox1.Items.Clear;
  sListBox1.Items.Assign(chau);

  url := sEdit1.Text;
  url2 := sEdit2.Text;

  if not(url = '') then
  begin
    PerlRegEx1.Regex := 'pastebin';
    PerlRegEx1.Subject := url;

    if PerlRegEx1.Match then
    begin
      sListBox1.Items.Add(url);
    end;
  end;

  if not(url2 = '') then
  begin

    code := IdHTTP1.Get(url2);

    PerlRegEx1.Regex := '(.)(http://.+?)\1';
    PerlRegEx1.Subject := code;

    while PerlRegEx1.MatchAgain do
    begin
      for i := 1 to PerlRegEx1.SubExpressionCount do
      begin
        viendo := PerlRegEx1.SubExpressions[i];

        PerlRegEx2.Regex := 'pastebin';
        PerlRegEx2.Subject := viendo;

        if PerlRegEx2.Match then
        begin
          sListBox1.Items.Add(viendo);
        end;
      end;
    end;

  end;

end;

procedure TForm2.sButton2Click(Sender: TObject);
var
  url: string;
  urlabajar: string;
  id: string;
  code: string;
  titulo: string;
  i: integer;
  archivobajado: TFileStream;
begin

  for i := sListBox1.Items.Count - 1 downto 0 do
  begin

    //

    url := sListBox1.Items[i];

    PerlRegEx1.Regex := 'http:\/\/(.*)\/(.*)';
    PerlRegEx1.Subject := url;

    if PerlRegEx1.Match then
    begin

      urlabajar :=
        'http://pastebin.com/download.php?i=' + PerlRegEx1.SubExpressions[2];
      // sMemo1.Lines.Add(urlabajar);

      code := IdHTTP1.Get(url);

      PerlRegEx2.Regex := '<div class="paste_box_line1" title="(.*)">';
      PerlRegEx2.Subject := code;

      if PerlRegEx2.Match then
      begin
        titulo := PerlRegEx2.SubExpressions[1];
        // sMemo1.Lines.Add(titulo);

        // Baja esto carajo

        // sStatusBar1.Panels[0].Text := '[+] Downloading :' + urlabajar;
        // Form2.sStatusBar1.Update;

        archivobajado := TFileStream.Create(titulo + '.txt', fmCreate);

        try
          begin
            DeleteFile(titulo);
            IdHTTP1.Get(urlabajar, archivobajado);
            sStatusBar1.Panels[0].Text := '[+] File Dowloaded';
            Form2.sStatusBar1.Update;
            archivobajado.Free;
          end;
        except
          sStatusBar1.Panels[0].Text := '[-] Failed download';
          Form2.sStatusBar1.Update;
          archivobajado.Free;
          Abort;
        end;


        //

      end;

    end;



    //

  end;

  sStatusBar1.Panels[0].Text := '[+] Done';
  Form2.sStatusBar1.Update;

end;

end.

// The End ?


Si quieren bajar el proyecto y el ejecutable lo pueden hacer de 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.