Una imagen
El codigo
Código
#!usr/bin/perl #Finder Paths 0.7 #Version Tk #Coded By Doddy H use Tk; use Tk::ListBox; use LWP::UserAgent; use HTML::LinkExtor; if ( $^O eq 'MSWin32' ) { use Win32::Console; Win32::Console::Free(); } my $background_fondo = "black"; my $texto_color = "cyan"; my $nave = LWP::UserAgent->new(); $nave->timeout(5); $nave->agent( "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12" ); $ha = MainWindow->new( -background => $background_fondo, -foreground => $texto_color ); $ha->title("Finder Paths 0.7 || (C) Doddy Hackman 2012"); $ha->geometry("510x430+20+20"); $ha->resizable( 0, 0 ); $ha->Label( -text => "Web : ", -font => "Impact1", -background => $background_fondo, -foreground => $texto_color my $pagine = $ha->Entry( -text => "http://localhost:8080/paths", -width => 40, -background => $background_fondo, -foreground => $texto_color $ha->Button( -text => "Search", -width => 10, -command => \&search, -background => $background_fondo, -foreground => $texto_color, -activebackground => $texto_color $ha->Button( -text => "Logs", -width => 10, -command => \&ver_logs, -background => $background_fondo, -foreground => $texto_color, -activebackground => $texto_color $ha->Label( -text => "Type : ", -font => "Impact1", -background => $background_fondo, -foreground => $texto_color $ha->Radiobutton( -text => "Fast", -value => "fast", -variable => \$type, -background => $background_fondo, -foreground => $texto_color, -activebackground => $texto_color $ha->Radiobutton( -text => "Full", -value => "full", -variable => \$type, -background => $background_fondo, -foreground => $texto_color, -activebackground => $texto_color $ha->Label( -text => "Paths Found", -font => "Impact", -background => $background_fondo, -foreground => $texto_color my $paths_list = $ha->Listbox( -width => 70, -height => 13, -background => $background_fondo, -foreground => $texto_color my $status_now = $ha->Label( -text => "Status : <None>", -font => "Impact", -background => $background_fondo, -foreground => $texto_color MainLoop; sub search { $paths_list->delete( "0.0", "end" ); $status_now->configure( -text => "Status : Scanning" ); if ( $type eq "fast" ) { simple( $pagine->get ); } if ( $type eq "full" ) { escalar( $pagine->get ); } $status_now->configure( -text => "Status : <None>" ); } sub ver_logs { if ( -f "paths-logs.txt" ) { } else { $ha->Dialog( -title => "Error", -buttons => ["OK"], -text => "File Not Found", -background => $background_fondo, -foreground => $texto_color, -activebackground => $texto_color )->Show(); } } sub escalar { my $co = $_[0]; my $code = toma( $_[0] ); my @links = get_links($code); if ( $code =~ /Index of (.*)/ig ) { $paths_list->insert( "end", $co ); savefile( "paths-logs.txt", $co ); my $dir_found = $1; while ( $code =~ /<a href=\"(.*)\">(.*)<\/a>/ig ) { my $ruta = $1; my $nombre = $2; unless ( $nombre =~ /Parent Directory/ig or $nombre =~ /Description/ig ) { } } } for my $com (@links) { $ha->update; my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] ); if ( $path =~ /\/(.*)$/ ) { my $path1 = $1; $_[0] =~ s/$path1//ig; my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com); if ( $path =~ /(.*)\// ) { my $parche = $1; unless ( $repetidos =~ /$parche/ ) { $repetidos .= " " . $parche; my $yeah = "http://" . $auth . $parche; escalar($yeah); } } for (@encontrados) { $ha->update; escalar($_); } } } } sub simple { my $code = toma( $_[0] ); my @links = get_links($code); for my $com (@links) { $ha->update; my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] ); if ( $path =~ /\/(.*)$/ ) { my $path1 = $1; $_[0] =~ s/$path1//ig; my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com); if ( $path =~ /(.*)\// ) { my $parche = $1; unless ( $repetidos =~ /$parche/ ) { $repetidos .= " " . $parche; my $code = toma( "http://" . $auth . $parche ); if ( $code =~ /Index of (.*)</ig ) { my $dir_found = $1; my $yeah = "http://" . $auth . $parche; $paths_list->insert( "end", $yeah ); savefile( "paths-logs.txt", $yeah ); } } } } } } sub toma { } sub get_links { $test = HTML::LinkExtor->new( \&agarrar )->parse( $_[0] ); sub agarrar { my ( $a, %b ) = @_; } } sub savefile { close SAVE; } #The End ?