[Roma.pm] salve!

LordOfDeath webmaster.staff at gmail.com
Tue Sep 12 12:44:46 PDT 2006


questo nn mi funziona azz.... nn so perkè 1 la finestra si blocca, 2 
sembra che le connessioni siano inattive....


#!/usr/bin/perl
use Tk;
use Tk::BrowseEntry;
use Tk::DialogBox;
use IO::Socket;
$mw = new MainWindow(title => "File exchange By LordOfDeath" );
$mw->Label(-text => '', -font => '{Verdana} 7 
bold',-foreground=>'red')->pack();
$mw->Label(-text => '')->pack();
$fleft=$mw->Frame()->pack ( -side => 'left', -anchor => 'ne') ;
$fright=$mw->Frame()->pack ( -side => 'left', -anchor => 'nw') ;
$mw->Label(-text => '')->pack();
$mw->Label(-text => '')->pack();
@files = <*>;
$b3 = $fright->BrowseEntry( -command => \&prendi, -relief => "groove", 
-variable => \$ne3, -font => '{Verdana} 8');
$b3->pack( -side => "top" , -anchor => 'w' );
$fright->Label(-text => '')->pack();
foreach $file(@files){
$b3->insert("end", "$file");
}

sub prendi{
 $InfoWindow=$mw->DialogBox(-title => 'File', -buttons => ["OK"]);
 $InfoWindow->add('Label', -text => "Selezionato $ne3!", -font => 
'{Verdana} 8 bold',-foreground=>'Green')->pack;
 $InfoWindow->Show();
 if ($InfoWindow eq "OK") {
  $InfoWindow->destroy();
}
}

$mw->Label(-text => 'MANDA', -font => '{Verdana} 7 
bold',-foreground=>'red')->pack();
$fleft->Label ( -text => '', -font => '{Verdana} 8 bold') ->pack ( -side 
=> "top" , -anchor => 'e' ) ;
$fleft->Label ( -text => '', -font => '{Verdana} 8 bold') ->pack ( -side 
=> "top" , -anchor => 'e' ) ;

$fleft->Label ( -text => 'IP DESTINATARIO', -font => '{Verdana} 8 bold') 
->pack ( -side => "top" , -anchor => 'e' ) ;
$destip=$fright->Entry ( -relief => "groove", -width => 35, -font => 
'{Verdana} 8', -textvariable => \$ip) ->pack ( -side => "top" , -anchor 
=> 'w' ) ;

$fleft->Label ( -text => 'PORTA DESTINATARIO', -font => '{Verdana} 8 
bold') ->pack ( -side => "top" , -anchor => 'e' ) ;
$destport=$fright->Entry ( -relief => "groove", -width => 35, -font => 
'{Verdana} 8', -textvariable => \$port) ->pack ( -side => "top" , 
-anchor => 'w' ) ;

$fright->Button(-text    => 'MANDA!!!',
                -relief => "groove",
                -width => '30',
                -font => '{Verdana} 8 bold',
                -activeforeground => 'red',
                -command => \&manda
               )->pack();

$mw->Label(-text => '', -font => '{Verdana} 7 
bold',-foreground=>'red')->pack();
$mw->Label(-text => '', -font => '{Verdana} 7 
bold',-foreground=>'red')->pack();
$mw->Label(-text => 'RICEVI', -font => '{Verdana} 7 
bold',-foreground=>'red')->pack();
$fleft->Label ( -text => '', -font => '{Verdana} 8 bold') ->pack ( -side 
=> "top" , -anchor => 'e' ) ;

$fleft->Label ( -text => 'PORTA RICEVENTE', -font => '{Verdana} 8 bold') 
->pack ( -side => "top" , -anchor => 'e' ) ;
$rcvport=$fright->Entry ( -relief => "groove", -width => 35, -font => 
'{Verdana} 8', -textvariable => \$rport) ->pack ( -side => "top" , 
-anchor => 'w' ) ;

              
$fright->Button(-text    => 'RICEVI!!!',
                -relief => "groove",
                -width => '30',
                -font => '{Verdana} 8 bold',
                -activeforeground => 'red',
                -command => \&listen
               )->pack();
              
sub manda{
my $sock = new IO::Socket::INET (
PeerAddr => $ip,
PeerPort => $port,
Proto => 'tcp',
);
die "Errore nell'inizializzazione della socket\n" unless $sock;
print $sock "CONNECTION ON\n";
while(defined($connection=<$sock>)){
print $connection;
if($connection=~/RCV ON/){
sleep 3;
open(FILE, ">$ne3");
print FILE $_;
close(FILE);
print $sock "CLOSE\n";
last;
}
}
close($sock);
}

sub listen{
my $sock2 = new IO::Socket::INET (
                               LocalHost => '127.0.0.1',
                               LocalPort => $rport,
                               Proto => 'tcp',
                               Listen => 1,
                               Reuse => 1,
                                 );
die "Could not create socket: $!\n" unless $sock2;
my $new_sock = $sock2->accept();
while(<$new_sock>) {
print $new_sock;
if($new_sock=~/CONNECTION ON/){
print $sock2 "RCV ON\n";
unless($new_sock=~/CLOSE/){
$file = $irc;
open(FILE, ">$file");
print FILE $_;
close(FILE);
}
}
print $_;
}
close($sock2);
}

MainLoop();


More information about the Roma mailing list