Форум dkLab и Denwer

Александр Михалицын · Posted: Sat Mar 24, 2007 6:38 pm () Post subject:

М

Выделено из темы «ICQ бот PHP»,
расположенной в форуме Склад готовых решений :: PHP (28 Августа 2010, 15:23).

root · Guest Карма: 388 поощрить/наказать

А вот вам небольной icq бот на perl

Code (perl):

#! /usr/bin/perl

# Простой icq-бот на перле
# (c) www.netwarez.org

use IO::Socket::INET;
use Net::OSCAR;
use Net::DNS;
use Text::Iconv;

%functions = ("google" => \&icq_bot_google,
"weather" => \&icq_bot_weather,
"dn2ip" => \&icq_bot_dn2ip,
"ip2dn" => \&icq_bot_ip2dn,
"mx" => \&icq_bot_mx);

$conv = Text::Iconv->new('utf-8','windows-1251');
$resolver = Net::DNS::Resolver->new();
$oscar = Net::OSCAR->new();
$oscar->set_callback_im_in(\&message_callback);

# свезло мне однако такой симпотный девятизнак c первого раза зарегать :)
$oscar->signon(353567373, "Password") or die (www.perldoc.com/perl5.6/pod/func/die.html)("Login failed\n");
$quit = 0;

while(!$quit) { $oscar->do_one_loop(); }

sub message_callback {
local (www.perldoc.com/perl5.6/pod/func/local.html)($cmd, $params, $result);
local (www.perldoc.com/perl5.6/pod/func/local.html) $result = "";
local (www.perldoc.com/perl5.6/pod/func/local.html)($client, $uin, $msg) = @_;

if(($cmd, $params) = $msg =~ /^\!([^\ ]+) (.+)$/)
{
$result = exists (www.perldoc.com/perl5.6/pod/func/exists.html)($functions{$cmd}) ? $functions{$cmd}($params) : "";
$client->send_im($uin, $result) if $result;
}
}

sub icq_bot_dn2ip { local (www.perldoc.com/perl5.6/pod/func/local.html) $dn = $_[0]; local (www.perldoc.com/perl5.6/pod/func/local.html) $t = gethostbyname (www.perldoc.com/perl5.6/pod/func/gethostbyname.html)($dn); return (www.perldoc.com/perl5.6/pod/func/return.html) $t ? "$dn\'s ip is ".inet_ntoa($t) : "Host does not exists"; }
sub icq_bot_ip2dn { local (www.perldoc.com/perl5.6/pod/func/local.html) $ip = $_[0]; local (www.perldoc.com/perl5.6/pod/func/local.html) $dn = gethostbyaddr (www.perldoc.com/perl5.6/pod/func/gethostbyaddr.html)(inet_aton($ip), AF_INET); return (www.perldoc.com/perl5.6/pod/func/return.html) $dn ? "$ip == $dn" : "Failed";}
sub icq_bot_mx {
local (www.perldoc.com/perl5.6/pod/func/local.html) $curr; local (www.perldoc.com/perl5.6/pod/func/local.html) $result = ""; local (www.perldoc.com/perl5.6/pod/func/local.html) $host = $_[0];
local (www.perldoc.com/perl5.6/pod/func/local.html) @mx = mx($resolver, $host) or return (www.perldoc.com/perl5.6/pod/func/return.html) " Failed";
foreach $curr(@mx) { $result .= " ".$curr->preference." - ".$curr->exchange.";"; }
return (www.perldoc.com/perl5.6/pod/func/return.html) $result;
}

sub icq_bot_google {
local (www.perldoc.com/perl5.6/pod/func/local.html)($url, $title, $text);
local (www.perldoc.com/perl5.6/pod/func/local.html)($request) = $_[0];
local (www.perldoc.com/perl5.6/pod/func/local.html) $data = http_get("www.google.com", "/search?filter=0&hl=ru&num=1&start=0&q=".url_encode($request), 1);

if(($url, $title, $text) = $data =~ /<h2 class=r><a class=l href=\"([^\"]+)\">(.+)<table border=0 cellpadding=0 cellspacing=0><tr><td class=j><font size=-1>(.+)<br><span class=a>/) {
$title = html_decode($conv->convert($title)); $text = html_decode($conv->convert($text));
if($title =~ /^(.+) \- \[ [^\]]+ \]$/){ $title = $1; }
return "$title: $text [$url]"; }
else { return "Nothing found"; }
}

sub icq_bot_weather {
local $tmp;
local $request = $_[0];
local $result = "";
local $data = http_get("weather.yandex.ru", "/search.xml?text=".url_encode($request), 0);

if(($tmp) = $data =~ /Location: \.([^\r\n]+)\r\n/)
{
$data = http_get("weather.yandex.ru", $tmp, 1);
($tmp) = $data =~ /<h2><b>([^\<]+)<\/b>/; $result = "$tmp: ";
($tmp) = $data =~ /<tr><td class=\"t t[0-9]{1,2}\">([^\<]+)<b><i><\/i><\/b><\/td>/; $result .= "$tmp ";
$result .= join(". ", $data =~ /<td><div>([^\<]+)<\/div>([^\<]+)<\/td><td><div>([^\<]+).<\/div>([^\<]+)<\/td><td><div>([^\<]+)<\/div>([^\<]+)<\/td>/);
return $result;
} else { return "Nothing found"; }
}

sub http_get {
local $tmp;
local $data = "";
local ($host, $request, $skip_headers) = @_;
local $sock = IO::Socket::INET->new("$host:80") or return "";
print $sock "GET $request HTTP/1.0\r\nHost: $host\r\nAccept-Charset: cp1251;q=0.7,*;q=0.7\r\n".
"User-Agent: Mozilla/5.0 (X11; U; FreeBSD i386; en-US; rv:1.8.0.4) Gecko/20060903 Firefox/1.5.0.4\r\n\r\n";
while(sysread($sock, $tmp, 1024) > 0){ $data .= $tmp; }; close $sock;
if($skip_headers){ $tmp = index($data, "\r\n\r\n") + 4; $data = substr($data, $tmp, length($data) - $tmp); }
return $data;
}

sub url_encode {
local $text = $_[0];
$text =~ s/([^a-zA-Z0-9]{1})/sprintf("%%%02x",ord($1))/eg;
return $text;
}

sub html_decode {
local $data = $_[0];
$data =~ s/\<[^\>]+\>//g;
$data =~ s/\<\;/\</;
$data =~ s/\>\;/\>/;
$data =~ s/\"\;/\"/;
$data =~ s/\&\;/\&/;
$data =~ s/\·\;/\xB7/;
return $data;

bæv

М

Ветка выделена в отдельную тему «спам»,
расположенную в форуме Мусоропровод (12 Февраля 2012, 21:04).

	Склад готовых решений :: Perl :: Форум dkLab и Denwer Forum Index	All times are GMT + 3 Hours
Page 1 of 1		Email to a Friend.