[Delphi] DH PasteBin Manager 0.2

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

Unas imagenes :

Los codigos :

Menu

Código

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

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

// 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 aca.