<b>perl版NC(Netcat)源码</b>[Delphi编程]

#!/usr/bin/perl

use strict;
use IO::Socket;
use IO::Select;
use Getopt::Std;

my%option;
getopts('lp:', %option);

# listen on local port
if(defined$option{'l'})
{
if( !defined$option{'p'})
{
&Usage();
exit(-1);
}

my$port = $option{'p'};
my$listen = IO::Socket::INET->new(Proto => 'tcp',
LocalPort => $port,
Listen => 1,
Reuse => 1)ordie"Listen on port $port error: $!n";

while(my$client_sock = $listen->accept())
{
&ProcessData($client_sock);
}
}

# if has no -l argument, maybe want to connect to other host
if(@ARGV != 2)
{
&Usage();
exit(-1);
}

my$client_sock = IO::Socket::INET->new(Proto => 'tcp', PeerHost => $ARGV[0], PeerPort => $ARGV[1]) || die"Connect to $ARGV[0]:$ARGV[1] error:$!n";
&ProcessData($client_sock);

sub ProcessData
{
my$client_sock = shift;

my$select = IO::Select->new();

$select->add( *STDIN);
$select->add($client_sock);

my$buffer;
while(1)
{
if( ! $select->exists($client_sock))
{
print"waiting connection....n";
last;
}

my@ready = $select->can_read;

formy$tmp_sock(@ready)
{
if($tmp_sock eq *STDIN)
{
if(my$recv_len = sysread( *STDIN, $buffer, 1024) )
{
if( ! syswrite($client_sock, $buffer))
{
$select->remove($client_sock);
$select->remove( *STDIN);
close($client_sock);

last;
}
}
else
{
$select->remove($client_sock);
$select->remove( *STDIN);
close($client_sock);

last;
}
}

elsif($tmp_sock eq $client_sock)
{
if(my$recv_len = sysread($client_sock, $buffer, 1024*5))
{
if( ! syswrite( *STDOUT, $buffer))
{
$select->remove($client_sock);
$select->remove( *STDIN);
close($client_sock);

last;
}
}
else
{
print"socket disconnected.n";
$select->remove($client_sock);
$select->remove( *STDIN);
close($client_sock);

last;
}
}
}
}
}

sub Usage
{
print"simple nc.pl, code by wustyunshu@hotmail.comn";
print"this script don't support -e cmd.exe, ^_^n";
print"Usage:n";
print"t -l -p 99n";
print"t 192.168.0.1 80n";
}