Форум dkLab и Denwer

[Александр Михалицын]

М

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

[root]

А вот вам небольной 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).