elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Únete al Grupo Steam elhacker.NET


+  Foro de elhacker.net
|-+  Programación
| |-+  Scripting
| | |-+  [Perl Tk] Finder Text 0.2
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Perl Tk] Finder Text 0.2  (Leído 1,969 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Perl Tk] Finder Text 0.2
« en: 23 Junio 2012, 18:16 pm »

Version Tk de un programa para buscar patrones en cualquier directorio.

Una imagen



El codigo

Código
  1. #!usr/bin/perl
  2. #Finder Text 0.2
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7.  
  8. my $color_fondo = "black";
  9. my $color_texto = "green";
  10.  
  11. #if ($^O eq 'MSWin32') {
  12. #use Win32::Console;
  13. #Win32::Console::Free();
  14. #}
  15.  
  16. my $vent =
  17.  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  18. $vent->title("Finder Text 0.2 (C) Doddy Hackman 2012");
  19. $vent->geometry("395x440+20+20");
  20. $vent->resizable( 0, 0 );
  21.  
  22. $vent->Label(
  23.    -text       => "Directory : ",
  24.    -font       => "Impact1",
  25.    -background => $color_fondo,
  26.    -foreground => $color_texto
  27. )->place( -x => 20, -y => 20 );
  28. my $dir = $vent->Entry(
  29.    -width      => 40,
  30.    -background => $color_fondo,
  31.    -foreground => $color_texto
  32. )->place( -x => 100, -y => 23 );
  33.  
  34. $vent->Label(
  35.    -text       => "String : ",
  36.    -font       => "Impact1",
  37.    -background => $color_fondo,
  38.    -foreground => $color_texto
  39. )->place( -x => 20, -y => 50 );
  40. my $string = $vent->Entry(
  41.    -width      => 30,
  42.    -background => $color_fondo,
  43.    -foreground => $color_texto
  44. )->place( -x => 80, -y => 53 );
  45.  
  46. $vent->Button(
  47.    -text             => "Find",
  48.    -command          => \&now,
  49.    -width            => 11,
  50.    -background       => $color_fondo,
  51.    -foreground       => $color_texto,
  52.    -activebackground => $color_texto
  53. )->place( -x => 271, -y => 53 );
  54.  
  55. $vent->Label(
  56.    -text       => "Files Found",
  57.    -font       => "Impact",
  58.    -background => $color_fondo,
  59.    -foreground => $color_texto
  60. )->place( -x => 150, -y => 100 );
  61. my $listas = $vent->Listbox(
  62.    -width      => 50,
  63.    -height     => 15,
  64.    -background => $color_fondo,
  65.    -foreground => $color_texto
  66. )->place( -x => 45, -y => 150 );
  67.  
  68. $vent->Label(
  69.    -text       => "Status : ",
  70.    -font       => "Impact1",
  71.    -background => $color_fondo,
  72.    -foreground => $color_texto
  73. )->place( -x => 70, -y => 390 );
  74. my $tatus = $vent->Entry(
  75.    -width      => 30,
  76.    -background => $color_fondo,
  77.    -foreground => $color_texto
  78. )->place( -x => 130, -y => 393 );
  79.  
  80. $listas->bind( "<Double-1>", [ \&loader ] );
  81.  
  82. MainLoop;
  83.  
  84. sub loader {
  85.    $listasx = $listas->curselection();
  86.    for my $id (@$listasx) {
  87.        my $linkar = $listas->get($id);
  88.        system("$linkar");
  89.    }
  90. }
  91.  
  92. sub now {
  93.    $listas->delete( "0.0", "end" );
  94.    goodbye( $dir->get, $string->get );
  95.    $tatus->configure( -text => " " );
  96. }
  97.  
  98. sub verificar {
  99.  
  100.    my ( $file, $text ) = @_;
  101.    my $numero_linea = 0;
  102.  
  103.    open( FILE, $file );
  104.    my @words = <FILE>;
  105.    close FILE;
  106.  
  107.    chomp @words;
  108.  
  109.    for my $linea (@words) {
  110.        chomp $linea;
  111.        $numero_linea++;
  112.        if ( $linea =~ /$text/ ) {
  113.            $listas->insert( "end", $file );
  114.        }
  115.    }
  116. }
  117.  
  118. sub goodbye {
  119.    opendir DIR, $_[0];
  120.    my @archivos = readdir DIR;
  121.    close DIR;
  122.  
  123.    for (@archivos) {
  124.        next if $_ eq "." or $_ eq "..";
  125.        my $fichero = $_[0] . "/" . $_;
  126.  
  127.        if ( -f $fichero ) {
  128.            $vent->update;
  129.            $tatus->configure( -text => $fichero );
  130.            verificar( $fichero, $_[1] );
  131.        }
  132.  
  133.        if ( -d $fichero ) {
  134.            &goodbye( $fichero, $_[1] );
  135.        }
  136.    }
  137. }
  138.  
  139. #The End ?
  140.  
  141.  


En línea

0xDani


Desconectado Desconectado

Mensajes: 1.077



Ver Perfil
Re: [Perl Tk] Finder Text 0.2
« Respuesta #1 en: 23 Junio 2012, 19:41 pm »

Esta bien, como siempre en tu linea.

Saludos ;D


En línea

I keep searching for something that I never seem to find, but maybe I won't, because I left it all behind!

I code for $$$
Hago trabajos en C/C++
Contactar por PM
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[Perl] Finder Paths
Scripting
BigBear 0 1,633 Último mensaje 14 Octubre 2011, 15:25 pm
por BigBear
[Perl] Finder Pass 0.3
Scripting
BigBear 0 1,654 Último mensaje 31 Marzo 2012, 22:46 pm
por BigBear
[Perl Tk] Finder Pass 0.4
Scripting
BigBear 0 1,610 Último mensaje 31 Marzo 2012, 22:47 pm
por BigBear
[Perl] Finder Paths 0.6
Scripting
BigBear 0 1,486 Último mensaje 8 Abril 2012, 01:55 am
por BigBear
[Perl] Finder Text 0.2
Scripting
BigBear 0 1,516 Último mensaje 23 Junio 2012, 18:15 pm
por BigBear
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines