Mensajes

reirme ? , no la veo una pregunta tonta , aca te dejo la definicion segun wiki

WHOIS es un protocolo TCP basado en petición/repuesta que se utiliza para efectuar consultas en una base de datos que permite determinar el propietario de un nombre de dominio o una dirección IP en Internet.

edito : actualice el post con un ejemplo de uso.

hacelo si queres.

Version Tk de un cliente whois que funciona mediante una pagina online.

Una imagen

El codigo

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#Whois Online 0.1
#Version Tk
#Coded By Doddy H

use Tk;
use Tk::ROText;
use LWP::UserAgent;

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);

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

my $color_fondo = "black";
my $color_texto = "white";

my $newas =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$newas->geometry("400x300+50+50");
$newas->title("Whois Online 0.1 || Coded By Doddy H");
$newas->resizable( 0, 0 );

$newas->Label(
    -text       => "Domain : ",
    -font       => "Impact2",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => "10", -y => "10" );
my $dom = $newas->Entry(
    -width      => "30",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => "85", -y => "13" );

my $console = $newas->Scrolled(
    "ROText",
    -scrollbars => "e",
    -width      => 36,
    -height     => 15,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 15, -y => 50 );

$newas->Button(
    -text             => "Search",
    -command          => \&buscar,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "50" );
$newas->Button(
    -text             => "Clean",
    -command          => \&limpiar,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "80" );
$newas->Button(
    -text             => "Exit",
    -command          => \&salir,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "110" );

MainLoop;

sub buscar {
    $console->delete( "0.1", "end" );
    my $target = $dom->get;
    $newas->update;
    $console->insert( "end", whois($target) );
    $newas->update;
}

sub limpiar {
    $console->delete( "0.1", "end" );
    $dom->delete( "0.1", "end" );
}

sub salir {
    exit 1;
}

sub whois {

    my $ob   = shift;
    my $code = tomar(
        "http://networking.ringofsaturn.com/Tools/whois.php",
        { "domain" => $ob, "submit" => "submit" }
    );

    my @chau = ( """, ">>>", "<<<" );

    if ( $code =~ /<pre>(.*?)<\/pre>/sig ) {
        my $resul = $1;
        chomp $resul;

        for my $cha (@chau) {
            $resul =~ s/$cha//ig;
        }

        if ( $resul =~ /Whois Server Version/ ) {
            return $resul;
        }
        else {
            return "Not Found";
        }
    }
}

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

# The End ?



[Net::Whois::Raw]

Debido a problemas con el modulo Net::Whois::Raw me vi obligado a realizar un whois mediante una pagina online.

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#Whois Online 0.1
#Coded By Doddy H

use LWP::UserAgent;

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);

head();
if ( $ARGV[0] ) {
    print whois( $ARGV[0] );
}
else {
    sintax();
}
copyright();

sub sintax {
    print "\n[+] Sintax : $0 <domain>\n";
}

sub head {
    print "\n-- == Whois Online 0.1 == --\n\n";
}

sub copyright {
    print "\n\n(C) Doddy Hackman 2012\n\n";
    exit(1);
}

sub whois {

    my $ob   = shift;
    my $code = tomar(
        "http://networking.ringofsaturn.com/Tools/whois.php",
        { "domain" => $ob, "submit" => "submit" }
    );

    my @chau = ( "&quot;", "&gt;&gt;&gt;", "&lt;&lt;&lt;" );

    if ( $code =~ /<pre>(.*?)<\/pre>/sig ) {
        my $resul = $1;
        chomp $resul;

        for my $cha (@chau) {
            $resul =~ s/$cha//ig;
        }

        if ( $resul =~ /Whois Server Version/ ) {
            return $resul;
        }
        else {
            return "Not Found";
        }
    }
}

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

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

# The End ?



Un simple script en Python para realizar un whois de forma online (mediante una pagina).

Código (python) [Seleccionar] Expandir


#!usr/bin/python
#Whois Online 0.1
#Coded By Doddy H

import urllib2,sys,re

nave = urllib2.build_opener()
nave.add_header = [('User-Agent','Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.5) Gecko/2008120122 Firefox/3.0.5')]

def tomar(web,vars) :
return nave.open(web,vars).read()

def head():
print "\n-- == Whois Online 0.1 == --\n\n"

def copyright():
print "\n(C) Doddy Hackman 2012\n"
sys.exit(1)

def sintax():
print "[+] Sintax : ",sys.argv[0]," <domain>\n"

def whois(domain):
try:
  code = tomar("http://networking.ringofsaturn.com/Tools/whois.php","domain="+domain+"&"+"submit=submit")
  if (re.findall("<PRE>(.*?)<\/PRE>",code,re.S)):
   found = re.findall("<PRE>(.*?)<\/PRE>",code,re.S)
   resul = found[0]
   resul = re.sub("&quot;","",resul)
   resul = re.sub("&gt;&gt;&gt;","",resul)
   resul = re.sub("&lt;&lt;&lt;","",resul)
   return resul
  else:
   return "Not Found"
except:
  print "[-] Page offline\n"

head()
if len(sys.argv) != 2 :
sintax()
else :
print whois(sys.argv[1])
copyright()

# The End


Un simple script en Ruby para hacer un whois al dominio que quieran.

Código (ruby) [Seleccionar] Expandir


#!usr/bin/ruby
#Whois Online 0.1
#Coded BY Doddy H

require "net/http"

def head()
 print "\n-- == Whois Online 0.1 == --\n\n"
end

def sintax()
 print "\n[+] Sintax : ruby domain.rb <domain>\n"
end

def copyright()
 print "\n\n(C) Doddy Hackman 2012\n\n"
end

def tomar(web,par)
 return Net::HTTP.post_form(URI.parse(web),par).body
end

def whois(dom)
 code = tomar("http://networking.ringofsaturn.com/Tools/whois.php",{"domain"=>dom,"submit"=>"submit"})
 if  code=~/<pre>(.*?)<\/pre>/mi
   final = $1
   final = final.sub(/&quot;/,"")
   final = final.sub(/&gt;&gt;&gt;/,"")
   final = final.sub(/&lt;&lt;&lt;/,"")
   return final
 else
   return "Not Found"
 end
end

domain = ARGV[0]

head()
if !domain
 sintax()
else
 print whois(domain)
end
copyright()
   
#The End ?


Version Tk de un cliente FTP que hice en Perl

Las opciones que tiene son

• Listado de archivos en un directorio
  
• Borrar archivos y directorios
  
• Crear directorios nuevos
  
• Renombrar
  
• Descargar y subir archivos
  
  Una imagen
  
  
  
  
  El codigo del programa
  
  
  Código (perl) [Seleccionar] Expandir
  
#!usr/bin/perl
#FTP Manager 0.2
#Version Tk
#Coded By Doddy H

use Tk;
use Tk::FileSelect;
use Cwd;
use Net::FTP;

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

my $color_fondo = "black";
my $color_texto = "cyan";

my $navedos =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );

$navedos->title("FTP Manager 0.2");
$navedos->geometry("218x150+20+20");
$navedos->resizable( 0, 0 );

$navedos->Label(
    -text       => "Host : ",
    -font       => "Impact1",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 10, -y => 10 );
my $host = $navedos->Entry(
    -width      => 23,
    -text       => "localhost",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 13 );

$navedos->Label(
    -text       => "User : ",
    -font       => "Impact1",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 10, -y => 40 );
my $user = $navedos->Entry(
    -width      => 23,
    -text       => "doddy",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 43 );

$navedos->Label(
    -text       => "Pass : ",
    -font       => "Impact1",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 10, -y => 70 );
my $pass = $navedos->Entry(
    -width      => 23,
    -text       => "doddy",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 73 );

$navedos->Button(
    -text             => "Connect",
    -width            => 13,
    -command          => \&now,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 60, -y => 110 );

MainLoop;

sub now {

    my $host = $host->get;
    my $user = $user->get;
    my $pass = $pass->get;

    my $socket = Net::FTP->new($host);
    if ( $socket->login( $user, $pass ) ) {

        $navedos->destroy;

        my $mandos = MainWindow->new(
            -background => $color_fondo,
            -foreground => $color_texto
        );
        $mandos->title("FTP Manager 0.2 || Coded By Doddy H");
        $mandos->geometry("565x335+20+20");
        $mandos->resizable( 0, 0 );

        $menul = $mandos->Frame(
            -relief     => "sunken",
            -bd         => 1,
            -background => $color_fondo,
            -foreground => $color_texto
        );
        my $menulnow = $menul->Menubutton(
            -text             => "Options",
            -underline        => 1,
            -background       => $color_fondo,
            -foreground       => $color_texto,
            -activebackground => $color_texto
        )->pack( -side => "left" );
        my $aboutnow = $menul->Menubutton(
            -text             => "About",
            -underline        => 1,
            -background       => $color_fondo,
            -foreground       => $color_texto,
            -activebackground => $color_texto
        )->pack( -side => "left" );
        my $exitnow = $menul->Menubutton(
            -text             => "Exit",
            -underline        => 1,
            -background       => $color_fondo,
            -foreground       => $color_texto,
            -activebackground => $color_texto
        )->pack( -side => "left" );
        $menul->pack( -side => "top", -fill => "x" );

        $menulnow->command(
            -label      => "Delete File",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&delnow
        );
        $menulnow->command(
            -label      => "Delete Directory",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&deldirnow
        );
        $menulnow->command(
            -label      => "Make Directory",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&makedirnow
        );
        $menulnow->command(
            -label      => "Rename",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&renamenow
        );
        $menulnow->command(
            -label      => "Download",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&downloadnow
        );
        $menulnow->command(
            -label      => "Upload",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&updatenow
        );

        $aboutnow->command(
            -label      => "About",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&aboutnownow
        );
        $exitnow->command(
            -label      => "Exit",
            -background => $color_fondo,
            -foreground => $color_texto,
            -command    => \&exitnow
        );

        $mandos->Label(
            -text       => "Directory : ",
            -font       => "Impact1",
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 23, -y => 40 );
        my $actual = $mandos->Entry(
            -text       => "/",
            -width      => 60,
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 105, -y => 43 );
        $mandos->Button(
            -width            => 8,
            -text             => "Enter",
            -command          => \&dirs,
            -background       => $color_fondo,
            -foreground       => $color_texto,
            -activebackground => $color_texto
        )->place( -x => 480, -y => 43 );

        $mandos->Label(
            -text       => "Directory",
            -font       => "Impact1",
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 130, -y => 90 );
        $mandos->Label(
            -text       => "Files",
            -font       => "Impact1",
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 350, -y => 90 );

        my $dir_now = $mandos->Listbox(
            -width      => 25,
            -height     => 13,
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 88, -y => 130 );
        my $files_now = $mandos->Listbox(
            -width      => 25,
            -height     => 13,
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 300, -y => 130 );

        sub exitnow {
            $socket->close();
            exit(1);
        }

        sub aboutnownow {
            $mandos->Dialog(
                -title            => "About",
                -buttons          => ["OK"],
                -text             => "Coded By Doddy H",
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->Show();
        }

        sub dirs {

            $dir_now->delete( "0.0", "end" );
            $files_now->delete( "0.0", "end" );

            if ( my @files = $socket->dir() ) {

                my @files_found;
                my @dirs_found;

                $socket->cwd( $actual->get );

                for my $fil (@files) {
                    my @to = split( " ", $fil );
                    my ( $dir, $file ) = @to[ 0, 8 ];
                    if ( $dir =~ /^d/ ) {
                        $dir_now->insert( "end", $file );
                    }
                    else {
                        $files_now->insert( "end", $file );
                    }
                }
            }
        }

        sub delnow {

            my $ventdos = MainWindow->new(
                -background => $color_fondo,
                -foreground => $color_texto
            );
            $ventdos->geometry("260x80+20+20");
            $ventdos->title("Delete File");
            $ventdos->resizable( 0, 0 );

            $ventdos->Label(
                -text       => "File : ",
                -font       => "Impact",
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 20, -y => 20 );
            my $filechau = $ventdos->Entry(
                -width      => 20,
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 60, -y => 26 );
            $ventdos->Button(
                -width            => 6,
                -text             => "Delete",
                -command          => \&delnowdos,
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->place( -x => 190, -y => 25 );

            sub delnowdos {
                if ( $socket->delete( $filechau->get ) ) {
                    $mandos->Dialog(
                        -title            => "Deleted",
                        -buttons          => ["OK"],
                        -text             => "File Deleted",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
                else {
                    $mandos->Dialog(
                        -title            => "Error",
                        -buttons          => ["OK"],
                        -text             => "Error",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
            }
        }

        sub deldirnow {

            my $venttres = MainWindow->new(
                -background => $color_fondo,
                -foreground => $color_texto
            );
            $venttres->geometry("300x80+20+20");
            $venttres->title("Delete Directory");
            $venttres->resizable( 0, 0 );

            $venttres->Label(
                -text       => "Directory : ",
                -font       => "Impact",
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 20, -y => 20 );
            my $dirchau = $venttres->Entry(
                -width      => 20,
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 99, -y => 26 );
            $venttres->Button(
                -width            => 6,
                -text             => "Delete",
                -command          => \&deldirnowdos,
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->place( -x => 230, -y => 25 );

            sub deldirnowdos {
                if ( $socket->rmdir( $dirchau->get ) ) {
                    $mandos->Dialog(
                        -title            => "Deleted",
                        -buttons          => ["OK"],
                        -text             => "Directory Deleted",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
                else {
                    $mandos->Dialog(
                        -title            => "Error",
                        -buttons          => ["OK"],
                        -text             => "Error",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
            }
        }

        sub makedirnow {

            my $ventcuatro = MainWindow->new(
                -background => $color_fondo,
                -foreground => $color_texto
            );
            $ventcuatro->geometry("300x80+20+20");
            $ventcuatro->title("Make Directory");
            $ventcuatro->resizable( 0, 0 );

            $ventcuatro->Label(
                -text       => "Directory : ",
                -font       => "Impact",
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 20, -y => 20 );
            my $dirnow = $ventcuatro->Entry(
                -width      => 20,
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 99, -y => 26 );
            $ventcuatro->Button(
                -width            => 6,
                -text             => "Make",
                -command          => \&makedirnowdos,
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->place( -x => 230, -y => 25 );

            sub makedirnowdos {

                if ( $socket->mkdir( $dirnow->get ) ) {
                    $mandos->Dialog(
                        -title            => "Ok",
                        -buttons          => ["OK"],
                        -text             => "Ok",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
                else {
                    $mandos->Dialog(
                        -title            => "Error",
                        -buttons          => ["OK"],
                        -text             => "Error",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
            }
        }

        sub renamenow {

            my $ventcinco = MainWindow->new(
                -background => $color_fondo,
                -foreground => $color_texto
            );
            $ventcinco->geometry("440x80+20+20");
            $ventcinco->title("Rename");
            $ventcinco->resizable( 0, 0 );

            $ventcinco->Label(
                -text       => "Name : ",
                -font       => "Impact",
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 20, -y => 20 );
            my $unonow = $ventcinco->Entry(
                -width      => 20,
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 74, -y => 26 );

            $ventcinco->Label(
                -text       => "To : ",
                -font       => "Impact",
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 210, -y => 20 );
            my $dosnow = $ventcinco->Entry(
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 240, -y => 26 );

            $ventcinco->Button(
                -width            => 6,
                -text             => "Rename",
                -command          => \&renamenowdos,
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->place( -x => 372, -y => 26 );

            sub renamenowdos {

                if ( $socket->rename( $unonow->get, $dosnow->get ) ) {
                    $mandos->Dialog(
                        -title            => "Ok",
                        -buttons          => ["OK"],
                        -text             => "Ok",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
                else {
                    $mandos->Dialog(
                        -title            => "Error",
                        -buttons          => ["OK"],
                        -text             => "Error",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
            }
        }

        sub updatenow {

            my $ventseis = MainWindow->new(
                -background => $color_fondo,
                -foreground => $color_texto
            );
            $ventseis->geometry("440x80+20+20");
            $ventseis->title("Upload");
            $ventseis->resizable( 0, 0 );

            $ventseis->Label(
                -text       => "File : ",
                -font       => "Impact",
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 20, -y => 20 );
            my $filenow = $ventseis->Entry(
                -width      => 40,
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 60, -y => 26 );

            $ventseis->Button(
                -width            => 8,
                -text             => "Browse",
                -command          => \&bronow,
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->place( -x => 310, -y => 26 );
            $ventseis->Button(
                -width            => 8,
                -text             => "Upload",
                -command          => \&updatenowdos,
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->place( -x => 365, -y => 26 );

            sub bronow {
                $browse = $ventseis->FileSelect( -directory => getcwd() );
                my $file = $browse->Show;
                $filenow->configure( -text => $file );
            }

            sub updatenowdos {

                if ( $socket->put( $filenow->get ) ) {
                    $mandos->Dialog(
                        -title            => "File uploaded",
                        -buttons          => ["OK"],
                        -text             => "Ok",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
                else {
                    $mandos->Dialog(
                        -title            => "Error",
                        -buttons          => ["OK"],
                        -text             => "Error",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
            }
        }

        sub downloadnow {

            my $ventsiete = MainWindow->new(
                -background => $color_fondo,
                -foreground => $color_texto
            );
            $ventsiete->geometry("270x80+20+20");
            $ventsiete->title("Downloader");
            $ventsiete->resizable( 0, 0 );

            $ventsiete->Label(
                -text       => "File : ",
                -font       => "Impact",
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 20, -y => 20 );
            my $filenownow = $ventsiete->Entry(
                -width      => 20,
                -background => $color_fondo,
                -foreground => $color_texto
            )->place( -x => 59, -y => 26 );
            $ventsiete->Button(
                -width            => 8,
                -text             => "Download",
                -command          => \&downloadnowdos,
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->place( -x => 190, -y => 25 );

            sub downloadnowdos {

                if ( $socket->get( $filenownow->get ) ) {
                    $mandos->Dialog(
                        -title            => "File downloaded",
                        -buttons          => ["OK"],
                        -text             => "Ok",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
                else {
                    $mandos->Dialog(
                        -title            => "Error",
                        -buttons          => ["OK"],
                        -text             => "Error",
                        -background       => $color_fondo,
                        -foreground       => $color_texto,
                        -activebackground => $color_texto
                    )->Show();
                }
            }
        }

    }
    else {
        $mandos->Dialog(
            -title            => "Error",
            -buttons          => ["OK"],
            -text             => "Error",
            -background       => $color_fondo,
            -foreground       => $color_texto,
            -activebackground => $color_texto
        )->Show();
    }
}

#The End ?


Nueva version de un cliente FTP que hice en Perl , en esta version se le arreglo varias cosas.

El codigo

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#FTP Manager 0.2
#Coded By Doddy H

use Net::FTP;

&head;

print "\n\n[FTP Server] : ";
chomp( my $ftp = <stdin> );
print "\n[User] : ";
chomp( my $user = <stdin> );
print "\n[Pass] : ";
chomp( my $pass = <stdin> );

if ( my $socket = Net::FTP->new($ftp) ) {
    if ( $socket->login( $user, $pass ) ) {

        print "\n\n[+] Enter of the server FTP\n";

      menu:

        print "\n\n>>";
        chomp( my $cmd = <stdin> );
        print "\n\n";

        if ( $cmd =~ /help/ ) {
            print q(
[+] Commands

[++] help : show information
[++] cd : change directory <dir>
[++] dir : list a directory
[++] mkdir : create a directory <dir>
[++] rmdir : delete a directory <dir>
[++] pwd : directory 
[++] del : delete a file <file>
[++] rename : change name of the a file <file1> <file2>
[++] size : size of the a file <file>
[++] put : upload a file <file>
[++] get : download a file <file>
[++] cdup : change dir <dir>
);
        }

        if ( $cmd eq "dir" ) {
            if ( my @files = $socket->dir() ) {

                my @files_found;
                my @dirs_found;

                for my $fil (@files) {
                    my @to = split( " ", $fil );
                    my ( $dir, $file ) = @to[ 0, 8 ];
                    if ( $dir =~ /^d/ ) {
                        push( @dirs_found, $file );
                    }
                    else {
                        push( @files_found, $file );
                    }
                }

                print "[++] Directory Found : " . int(@dirs_found) . "\n";
                print "\n[+] Files Found : " . int(@files_found) . "\n\n";

                for my $dires (@dirs_found) {
                    print "[++] : $dires\n";
                }

                for my $filex (@files_found) {
                    print "[+] : $filex\n";
                }

            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /pwd/ig ) {
            print "[+] Path : " . $socket->pwd() . "\n";
        }

        if ( $cmd =~ /cd (.*)/ig ) {
            if ( $socket->cwd($1) ) {
                print "[+] Directory changed\n";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /cdup/ig ) {
            if ( my $dir = $socket->cdup() ) {
                print "[+] Directory changed\n\n";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /del (.*)/ig ) {
            if ( $socket->delete($1) ) {
                print "[+] File deleted\n";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /rename (.*) (.*)/ig ) {
            if ( $socket->rename( $1, $2 ) ) {
                print "[+] File Updated\n";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /mkdir (.*)/ig ) {
            if ( $socket->mkdir($1) ) {
                print "[+] Directory created\n";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /rmdir (.*)/ig ) {
            if ( $socket->rmdir($1) ) {
                print "[+] Directory deleted\n";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /size (.*)/ig ) {
            print "[+] Size : " . $socket->size($1) . "\n\n";
        }

        if ( $cmd =~ /exit/ig ) {
            copyright();
            exit(1);
        }

        if ( $cmd =~ /get (.*)/ig ) {
            print "[+] Downloading file\n\n";
            if ( $socket->get($1) ) {
                print "[+] Download completed";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        if ( $cmd =~ /put (.*)/ig ) {
            print "[+] Uploading file\n\n";
            if ( $socket->put($1) ) {
                print "[+] Upload completed";
            }
            else {
                print "[-] Error\n\n";
            }
        }

        goto menu;

    }
    else {
        print "\n\n[-] Failed the login\n\n";
    }

}
else {
    print "\n\n[-] Error\n\n";
}

sub head {
    print "\n\n -- == FTP Manager 0.2 == --\n\n";
}

sub copyright {
    print "\n\n(C) Doddy Hackman 2012\n\n";
}

# The End ?


Nueva version Tk de un Mysql manager que hice hace tiempo.

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#Mysql Manager 0.6
#Version Tk
#Coded By Doddy H
#Modules
#ppm install http://www.bribes.org/perl/ppm/Scalar-List-Utils.ppd
#ppm install http://www.bribes.org/perl/ppm/Storable.ppd
#ppm install http://www.bribes.org/perl/ppm/DBI.ppd
#ppm install http://theoryx5.uwinnipeg.ca/ppms/DBD-mysql.ppd

use Tk;
use Tk::ROText;
use Tk::PNG;
use DBI;

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

my $color_fondo = "black";
my $color_texto = "orange";

my $nave =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );

$nave->title("Mysql Manager 0.6 || Coded By Doddy H");
$nave->geometry("210x160+20+20");
$nave->resizable( 0, 0 );

$nave->Label(
    -text       => "Host : ",
    -font       => "Impact1",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 10, -y => 10 );
my $host = $nave->Entry(
    -width      => 22,
    -text       => "localhost",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 13 );

$nave->Label(
    -text       => "User : ",
    -font       => "Impact1",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 10, -y => 40 );
my $user = $nave->Entry(
    -width      => 22,
    -text       => "root",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 43 );

$nave->Label(
    -text       => "Pass : ",
    -font       => "Impact1",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 10, -y => 70 );
my $pass = $nave->Entry(
    -width      => 22,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 73 );

$nave->Button(
    -text             => "Connect",
    -width            => 13,
    -command          => \&now,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => "orange"
)->place( -x => 60, -y => 120 );

MainLoop;

sub now {

    my $host = $host->get;
    my $user = $user->get;
    my $pass = $pass->get;

    $info = "dbi:mysql::" . $host . ":3306";

    if ( my $enter = DBI->connect( $info, $user, $pass, { PrintError => 0 } ) )
    {

        $nave->destroy;

        my $man = MainWindow->new(
            -background => $color_fondo,
            -foreground => $color_texto
        );
        $man->title("Mysql Manager 0.6 || Coded By Doddy H");
        $man->geometry("650x320+20+20");
        $man->resizable( 0, 0 );

        $man->Label(
            -text       => "Query : ",
            -font       => "Impact1",
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 73, -y => 20 );
        my $ac = $man->Entry(
            -width      => 60,
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 135, -y => 23 );
        $man->Button(
            -width            => 8,
            -text             => "Execute",
            -command          => \&tes,
            -background       => $color_fondo,
            -foreground       => $color_texto,
            -activebackground => "orange"
        )->place( -x => 510, -y => 23 );
        my $out = $man->Scrolled(
            "ROText",
            -width      => 74,
            -height     => 15,
            -background => $color_fondo,
            -foreground => $color_texto
        )->place( -x => 60, -y => 73 );

        $man->bind( "<Key-Return>" => sub { &tes } );

        sub tes {
            my $ac = $ac->get;
            $re = $enter->prepare($ac);
            $re->execute();
            my $total = $re->rows();

            my @columnas = @{ $re->{NAME} };

            if ( $total eq "-1" ) {
                $out->insert( "end", "\n[-] Query Error\n" );
                next;
            }
            else {
                $out->insert( "end", "\n[+] Result of the query\n" );
                if ( $total eq 0 ) {
                    $out->insert( "end", "\n[+] Not rows returned\n\n" );
                }
                else {
                    $out->insert( "end",
                        "\n[+] Rows returned : " . $total . "\n\n" );
                    for (@columnas) {
                        $out->insert( "end", $_ . "\t" );
                    }
                    $out->insert( "end", "\n\n" );
                    while ( @row = $re->fetchrow_array ) {
                        for (@row) {
                            $out->insert( "end", $_ . "\t" );
                        }
                        $out->insert( "end", "\n" );
                    }
                }
            }
        }
    }
    else {
        $man->Dialog(
            -title            => "Error",
            -buttons          => ["OK"],
            -text             => "Error",
            -background       => $color_fondo,
            -foreground       => $color_texto,
            -activebackground => $color_texto
        )->Show();
    }
}

# ¿ The End ?



Nueva version de un mysql manager que hice hace un largo tiempo.

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#Mysql Manager 0.5
#Coded By Doddy H
#Modules
#ppm install http://www.bribes.org/perl/ppm/Scalar-List-Utils.ppd
#ppm install http://www.bribes.org/perl/ppm/Storable.ppd
#ppm install http://www.bribes.org/perl/ppm/DBI.ppd
#ppm install http://theoryx5.uwinnipeg.ca/ppms/DBD-mysql.ppd

use DBI;

sub head {
    print "\n\n -- == Mysql Manager 0.5 == --\n\n";
}

sub copyright {
    print "\n\n-- == (C) Doddy Hackman 2012 == --\n\n";
    exit(1);
}

sub sintax {
    print "\n[+] Sintax : $0 <host> <user> <pass>\n";
}

head();
unless ( @ARGV > 2 ) {
    sintax();
}
else {
    enter( $ARGV[0], $ARGV[1], $ARGV[2] );
}
copyright();

sub enter {

    print "\n[+] Connecting to the server\n";

    $info = "dbi:mysql::" . $_[0] . ":3306";
    if ( my $enter = DBI->connect( $info, $_[1], $_[2], { PrintError => 0 } ) )
    {

        print "\n[+] Enter in the database";

        while (1) {
            print "\n\n\n[+] Query : ";
            chomp( my $ac = <stdin> );

            if ( $ac eq "exit" ) {
                $enter->disconnect;
                print "\n\n[+] Closing connection\n\n";
                copyright();
            }

            $re = $enter->prepare($ac);
            $re->execute();
            my $total = $re->rows();

            my @columnas = @{ $re->{NAME} };

            if ( $total eq "-1" ) {
                print "\n\n[-] Query Error\n";
                next;
            }
            else {
                print "\n\n[+] Result of the query\n";
                if ( $total eq 0 ) {
                    print "\n\n[+] Not rows returned\n\n";
                }
                else {
                    print "\n\n[+] Rows returned : " . $total . "\n\n\n";
                    for (@columnas) {
                        print $_. "\t\t";
                    }
                    print "\n\n";
                    while ( @row = $re->fetchrow_array ) {
                        for (@row) {
                            print $_. "\t\t";
                        }
                        print "\n";
                    }
                }
            }
        }
    }
    else {
        print "\n[-] Error connecting\n";
    }
}

# ¿ The End ?