Autor Tema: [Perl Tk] Pastebin Uploader (Leído 1333 veces)

BigBear · « **en:** Mayo 27, 2011, 03:36:58 am »

Un lindo programa para publicar varios o un codigo en pastebin

Imagenes

#!usr/bin/perl
#PasteBin Uploader 0.5 (C) Doddy Hackman 2011

use Tk;
use Tk::FileSelect;
use Win32;
use LWP::UserAgent;

if ($^O eq 'MSWin32') {
use Win32::Console; 
Win32::Console::Free();
}

my $nave = LWP::UserAgent->new;
$nave->agent("Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12");
$nave->timeout(5);

my $logo = MainWindow->new();
$logo->title("PasteBin Uploader 0.5");
$logo->geometry("300x130+20+20");
$logo->resizable(0,0);
$logo->Label(-text=>"Options",-font=>"Impact1")->place(-x=>115,-y=>10);
$logo->Button(-text=>"File",-width=>20,-command=>\&single)->place(-y=>50,-x=>10);
$logo->Button(-text=>"Directory",-width=>20,-command=>\&di)->place(-y=>50,-x=>150);
$logo->Button(-text=>"Show Logs",-width=>20,-command=>\&lognow)->place(-x=>75,-y=>88);

MainLoop;

sub single {

$sin = MainWindow->new();
$sin->title("Pastebin Uploader 0.5 (C) Doddy Hackman 2011");
$sin->geometry("550x80+20+20");
$sin->Label(-text=>"File : ",-font=>"Impact1")->place(-x=>20,-y=>20);
my $filex = $sin->Entry(-width=>50)->place(-y=>25,-x=>65);
$sin->Button(-text=>"Browse",-width=>10,-command=>\&bro)->place(-y=>23,-x=>375);
$sin->Button(-text=>"Upload",-width=>10,-command=>\&singleup)->place(-y=>23,-x=>450);

sub bro { 
$sin->update;
$browse = $sin->FileSelect(-directory => "/");
my $file = $browse->Show;
$filex->configure (-text =>$file);
}

sub singleup {

my $file = $filex->get();
chomp $file;

if (-f $file)  {

($name,$exta) =verfile($file);

my $ext = extensiones($exta);

if ($ext ne "Yet") {


$code = openfile($file);

$re = lleva($name,$code,$ext);

unless($re=~/Bad API request/ig) {
Win32::MsgBox("Uploaded!!!",0,"PasteBin Uploader");
savefile("uploads_paste.txt","\n[+] File : $file");
savefile("uploads_paste.txt","[+] Link : ".$re);
} else {
Win32::MsgBox("Error uploading",0,"PasteBin Uploader 0.5");
}
}
} else {
Win32::MsgBox("File Error",0,"PasteBin Uploader 0.5");
}
}
}


sub di {


my $more = MainWindow->new();
$more->title("Pastebin Uploader 0.5 (C) Doddy Hackman 2011");
$more->geometry("450x280+50+50");
$more->resizable(0,0);

$more->Label(-text=>"Directory : ",-font=>"Impact1")->place(-y=>10,-x=>10);
my $filex = $more->Entry(-width=>35)->place(-y=>15,-x=>80);
$more->Button(-text=>"Start",-width=>10,-command=>\&multi)->place(-y=>12,-x=>300);
$more->Button(-text=>"Browse",-width=>10,-command=>\&poner)->place(-x=>370,-y=>12);

$more->Label(-text=>"Files")->place(-y=>70,-x=>65);
my $lista_archivos = $more->Listbox(-width=>32)->place(-y=>100,-x=>20);

$more->Label(-text=>"Status")->place(-y=>70,-x=>300);
my $lista_re = $more->Listbox(-width=>32)->place(-y=>100,-x=>230);


sub poner {
my $ven = MainWindow->new();
$ven->title("Choose Directory");
$ven->geometry("300x280+20+20");
$ven->resizable(0,0);
$test = $ven->Scrolled("DirTree",-width=>100,-height=>20,-exportselection=>1,-command=>\&choose)->pack();

sub choose {
$filex->configure(-text=>$_[0]);
$ven->destroy;
}
}

sub multi {

my $dir = $filex->get();

if (-d $dir) {

my @files = verdir($dir);

for my $file(@files) {

chomp $file;

my ($name,$exta) =verfile($file);

my $ext = extensiones($exta);

if ($ext ne "Yet") {

my $code = openfile($dir."/".$file);
$lista_archivos->insert("end",$file);
$logo->update;
$re = lleva($name,$code,$ext);
unless($re=~/Bad API request/ig) {
$lista_re->insert("end","File Uploaded !!");
savefile("uploads_paste.txt","\n[+] File : $file");
savefile("uploads_paste.txt","[+] Link : ".$re);
} else {
$lista_re->insert("end","Error uploading");
}
}
}
} else {
Win32::MsgBox("Directory Error",0,"PasteBin Uploader 0.5");
}

}


}

sub lognow {
if (-f "logs/uploads_paste.txt") {
system("start logs/uploads_paste.txt");
}
}

sub toma {
return $nave->get($_[0])->content;
}

sub savefile {
open (SAVE,">>logs/".$_[0]);
print SAVE $_[1]."\n";
close SAVE; 
}

sub tomar {
my ($web,$var) = @_;
return $nave->post($web,[%{$var}])->content;
}


sub verdir{
my @files;
my @archivos;
opendir DIR,$_[0];
my @archivos = readdir DIR;
for (@archivos) {
if (-f $_[0]."/".$_) {
push(@files,$_)
}
}
return @files;
}

sub verfile {
if ($_[0]=~/(.*)\.(.*)/ig) {
return ($1,$2);
}
}

sub extensiones {

if ($_[0] =~/py/ig) {
$code  = "python";
}
elsif ($_[0] =~/pl/ig) {
$code = "perl";
}
elsif ($_[0] =~/rb/ig) {
$code = "ruby";
}
elsif ($_[0] =~/php/ig) {
$code = "php";
}
elsif ($_[0] =~/txt/ig) {
$code = "";
}
else {
$code = "Yet";
}
return $code;
}

sub openfile {
	
my $r;

open (FILE,$_[0]);
@wor = <FILE>;
close FILE;
for(@wor) {
$r.= $_;
}
return $r;
}

sub lleva {
return $nave->post('http://pastebin.com/api_public.php',{ paste_code => $_[1],paste_name=> $_[0],paste_format=>$_[2],paste_expire_date=>'N',paste_private=>"public",submit=>'submit'})->content;
}
 
# ¿ The End ?

¿Sabes el motivo de que fallen tanto algunas impresoras Epson?

Autor Tema: [Perl Tk] Pastebin Uploader (Leído 1333 veces)

BigBear

[Perl Tk] Pastebin Uploader