Форум dkLab и Denwer
Здесь общаются Web-разработчики.
Генеральный спонсор:
Хостинг «Джино»

Простенький ICQ бот (root)
Author Message
Александр Михалицын
Модератор



Joined: 23 May 2008
Posts: 1299
Карма: 81
   поощрить/наказать


PostPosted: Sat Mar 24, 2007 6:38 pm ()
   Post subject:
Reply with quote


М

Выделено из темы «ICQ бот PHP»,
расположенной в форуме Склад готовых решений :: PHP (28 Августа 2010, 15:23).
Back to top
View user's profile Send private message Send e-mail
root
Guest





Карма: 386
   поощрить/наказать


PostPosted: Sat Mar 24, 2007 6:38 pm (спустя 1 секунду; написано за 39 секунд)
   Post subject:
Reply with quote

А вот вам небольной 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;
Back to top
bæv
Модератор «Дзена»



Joined: 27 Aug 2003
Posts: 7275
Карма: 9994
   поощрить/наказать


PostPosted: Sun Feb 12, 2012 8:04 pm (спустя 4 года 10 месяцев 19 дней 1 час 26 минут)
   Post subject:
Reply with quote


М

Ветка выделена в отдельную тему «спам»,
расположенную в форуме Мусоропровод (12 Февраля 2012, 21:04).
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic All times are GMT + 3 Hours
Page 1 of 1    Email to a Friend.
You cannot post new topics in this forum. You cannot reply to topics in this forum. You cannot edit your posts in this forum. You cannot delete your posts in this forum. You cannot vote in polls in this forum. You cannot attach files in this forum. You can download files in this forum.
XML