[Delphi] ImageShack Uploader 0.1

Iniciado por BigBear, Octubre 11, 2013, 02:55:17 PM

Tema anterior - Siguiente tema

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

Un simple programa para subir imagenes a ImageShack.

Una imagen :



El codigo :

Código: delphi

// ImageShack Uploader 0.1
// Based in the API of ImageShack
// Coded By Doddy H

unit image;

interface

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

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    sSkinManager1: TsSkinManager;
    sGroupBox1: TsGroupBox;
    sEdit1: TsEdit;
    sButton1: TsButton;
    sGroupBox2: TsGroupBox;
    sEdit2: TsEdit;
    sStatusBar1: TsStatusBar;
    sGroupBox3: TsGroupBox;
    sButton2: TsButton;
    sButton3: TsButton;
    sButton4: TsButton;
    sButton5: TsButton;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    PerlRegEx1: TPerlRegEx;

    procedure FormCreate(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton5Click(Sender: TObject);
    procedure sButton4Click(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

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

  OpenDialog1.InitialDir := GetCurrentDir;
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin

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

end;

procedure TForm1.sButton2Click(Sender: TObject);
var
  datos: TIdMultiPartFormDataStream;
  code: string;
begin

  if FileExists(sEdit1.Text) then
  begin

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

    datos := TIdMultiPartFormDataStream.Create;
    datos.AddFormField('key', 'fuck you');
    datos.AddFile('fileupload', sEdit1.Text, 'application/octet-stream');
    datos.AddFormField('format', 'json');

    code := IdHTTP1.Post('http://post.imageshack.us/upload_api.php', datos);

    PerlRegEx1.Regex := '"image_link":"(.*?)"';
    PerlRegEx1.Subject := code;

    if PerlRegEx1.Match then
    begin
      sEdit2.Text := PerlRegEx1.SubExpressions[1];
      sStatusBar1.Panels[0].Text := '[+] Done';
      Form1.sStatusBar1.Update;
    end
    else
    begin
      sStatusBar1.Panels[0].Text := '[-] Error uploading';
      Form1.sStatusBar1.Update;
    end;

  end
  else
  begin
    sStatusBar1.Panels[0].Text := '[+] File not Found';
    Form1.sStatusBar1.Update;
  end;

end;

procedure TForm1.sButton3Click(Sender: TObject);
begin
  sEdit2.SelectAll;
  sEdit2.CopyToClipboard;
end;

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

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

end.

// The End ?


Si lo quieren bajar lo pueden hacer de No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.