[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