|
|
|
|
|
Парсер для гугля. Был составлен пару лет назад. Проверил, до сих пор работает (с корректировкой от даты 09.02.13).
Файл do.pl
| Код: |
#!/usr/bin/perl
$|=1;
srand;
# Freeware forever and everywhere
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use HTTP::Cookies;
use LWP::Simple;
my $browser = LWP::UserAgent->new();
$browser->cookie_jar({});
$browser->agent("Mozilla/4.0 (compatible; MSIE 7.0;)");
$browser->timeout(15);
$reqlinklast = "http://www.google.com/";
@find = openfile("find.txt");
foreach $el (@find) {
if ($el =~ /^stop/i) { print "\n\nstop from file\n\n"; sleep 15; exit; }
if (length($el)>1) {
for ($i = 0; $i<=9; $i++) {
$start = $i * 100;
$q = perl_urlencode($el);
print "$el '$q' start from '$start' ";
$reqlink = "http://www.google.com/search?q=".$q."&num=100&hl=en&start=".$start;
my $responde = HTTP::Request->new(GET => $reqlink);
$responde->referer($reqlinklast);
my $rez = $browser->request($responde)->as_string;
my ($statusline) = split(/\n/, $rez);
my ($no, $code, $no) = split(/\s/, $statusline);
print "'$code' ". length($rez)." bytes ";
$rez =~ s/\n//g;
$rez =~ s/\r//g;
my @tmp = ($rez =~ /h3\sclass="r"><a\shref="(.*?)"/ig);
$ic = 1; foreach $lnk (@tmp) {
$lnk =~ s/\/url\?q=//ig; # корректировка от даты 09.02.13
my ($lnk) = split(/&/, $lnk); # корректировка от даты 09.02.13
#print "$ic--$lnk--\n";
file_write_add("ponyBase.txt", $lnk."\n");
$ic++; }
print "find links '$ic' ";
if ($ic <= 25) { print " (next req) "; last; }
sleep 5;
$reqlinklast = $reqlink;
print "\n";
}
}
}
exit;
############# FUNCTIONS ###############
sub html2text_easy {
my $H = shift;
my $ret;
($ret = $H) =~ s/<[^>]*>//gs;
return $ret;
}
sub fget {
my $file = shift;
return "" unless (fexist($file));
open(RFILE, $file); my $filevalue = <RFILE>; close(RFILE);
return $filevalue;
}
sub fput {
my ($file, $putvalue) = @_;
#return file_create($file) unless(length($putvalue));
#open(WCFILE, ">". safefilename($file));
open(WCFILE, ">". $file);
#chmod(0666, safefilename($file)) if ($use_chmod);
print WCFILE $putvalue;
close(WCFILE);
return 0;
}
sub fexist {
my $file = shift;
return 1 if (-e $file);
return 0;
}
sub glas {
my $length = shift;
my $ret = "";
@strarr = ("e","y","u","i","o","a");
push(@strarr, @strarr); shufflearray(\@strarr); for ($i=1;$i<=$length;$i++) { $ret = $ret . raeh(\@strarr); }
return $ret;
}
sub soglas {
my $length = shift;
my $ret = "";
@strarr = ("q","w","r","t","p","s","d","f","g","h","j","k",&q
uot;l","z","x","c","v","b","n","m");
push(@strarr, @strarr); shufflearray(\@strarr); for ($i=1;$i<=$length;$i++) { $ret = $ret . raeh(\@strarr); }
return $ret;
}
sub slovo { my $length = shift; my $ret = ""; my $c = 0; while (length($ret)<$length) {if ($c==0) { $ret = $ret . soglas(1); $c=1; } else { $ret = $ret . glas(1); $c=0; }}return $ret;}
sub perl_urlencode {
my $str = shift;
$str =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
return $str;
}
sub perl_urldecode {
my $str = shift;
$str =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
return $str;
}
sub get_linksankor_from_content {
my $text = shift;
$text =~ s/\n//g;
$text =~ s/\r//g;
my @r = ($text =~ /href="(.*?)<\/a>/ig);
return (@r);
}
sub shufflearray {
my $array = shift;
my $i;
for ($i = @$array; --$i; ) {
my $j = int rand ($i+1);
next if $i == $j;
@$array[$i,$j] = @$array[$j,$i];
}
}
sub linkprocessor_v1 {
my $text = shift;
}
sub getdomainfromstr {
my $text = shift;
my (undef, undef, $domain) = split(/\//, $text);
$domain =~ s/^www\.//;
my $tchss = 0;
while ($domain =~ /\./g) { $tchss++; }
if ($tchss == 1) { $domain = "www.".$domain; }
return $domain;
}
sub RT_ME_TIME {
my ($sec, $min, $hour, $d, $m, $y) = (localtime)[0,1,2,3,4,5];
$m = $m + 1;
$y = $y + 1900;
return "$hour:$min:$sec $d-$m-$y";
}
sub RT_ME_TIME2 {
my $in = shift;
$sec = int $in;
$min = int $in/60;
$hour = int $in/3600;
$d = int $in/86400;
return "$hour/$min/$sec/$d (h/m/s/d)";
}
sub RN_filter {
my $text = shift;
$text =~ s/\r//g;
$text =~ s/\n//g;
return $text;
}
sub fsize {
my $file = shift;
return (-s $file) if (fexist($file));
return 0;
}
sub fsizeKB {
my $file = shift;
return ((-s $file)/1024) if (fexist($file));
return 0;
}
sub fsizeMB {
my $file = shift;
return (((-s $file)/1024)/1024) if (fexist($file));
return 0;
}
sub fexist {
my $file = shift;
return 1 if (-e $file);
return 0;
}
sub erasefile {
my $file = shift;
unlink($file);
open FILE, ">" . $file;
close FILE;
return 1;
}
sub fwa {
return file_write_add(@_);
}
sub file_write_add {
my $file = shift;
my $text = shift;
open(ADDFILE, ">>".$file);
print ADDFILE $text;
close(ADDFILE);
return 1;
}
sub openfile {
my $file = shift;
open(FILE, $file);
my (@filec) = <FILE>;
close(FILE);
chomp(@filec);
my (@int_arr);
foreach my $p_el (@filec) {
$p_el =~ s/\r//g;
$p_el =~ s/\n//g;
push(@int_arr, $p_el);
}
return (@int_arr);
}
sub rndstrfromfile {
my $file = shift;
my @a = openfile($file);
return $a[int(rand($#a + 1))];
}
sub loadlinks {
my $fromdir = shift;
my (@a, @a_tmp);
opendir(DIR, $fromdir);
while(defined($file = readdir(DIR))) {
if ($file ne "." && $file ne "..") {
push(@a_tmp, $fromdir . $file);
}
}
closedir(DIR);
$file = $a_tmp[int(rand($#a_tmp + 1))];
@a = openfile($fromdir . $file);
protocol("i'm select DB as '$fromdir$file'");
return (@a);
}
sub rae {
my (@a) = @_;
return $a[int(rand($#a + 1))];
}
sub raeh {
my $array_link = shift;
return $array_link->[int(rand($#$array_link + 1))];
}
sub ca_link {
my $x = shift;
#for (my $i=0; $i < @$x; $i++) { }
return @$x;
}
sub cuta_down {
my $maxlines = shift;
my (@a) = @_;
while (ca_link(\@a) > $maxlines) {
pop(@a);
}
return (@a);
}
sub uniquea {
my @a = @_;
my (%seen, @u);
%seen = ();
foreach my $i (@a) { push(@u, $i) unless $seen{$i}++; }
#@u = grep { ! $seen{$_} ++ } @list;
return (@u);
}
sub downstr {
$t = shift;
return lc($t);
}
sub upstr {
$t = shift;
return uc($t);
}
sub ute_text {
return scalar(localtime);
}
sub ute {
return time();
}
sub rnclear {
$text = shift;
$text =~ s/\r//g;
$text =~ s/\n//g;
return $text;
}
sub rnsclear {
$text = shift;
$text =~ s/\r//g;
$text =~ s/\n//g;
$text =~ s/^\s+//;
$text =~ s/\s+$//;
return $text;
}
sub is_element_present_in_array {
my $check_element = shift;
my (@a) = @_;
foreach my $e (@a) {
if (rnsclear($check_element) eq rnsclear($e)) { return 1; }
}
return 0;
}
sub gg {
my $link_gg = shift;
my $ref_gg = shift;
my $USE_SPAM_METHOD = shift || "GET";
my $R = 0;
my ($content, $content_head);
$RM = 'GET' if ($USE_SPAM_METHOD eq "GET");
$RM = 'HEAD' if ($USE_SPAM_METHOD eq "HEAD");
my $req = new HTTP::Request $RM => $link_gg;
$req->referer($ref_gg);
my $res = $ua->request($req);
if ($res->is_success) {
unless ($res->content_type eq 'text/html') {
protocol(" -gg- document is not HTML content! ");
$R = 0;
return $R;
}
if ($USE_SPAM_METHOD eq "GET") { $content = $res->content(); } # as_string
if ($USE_SPAM_METHOD eq "HEAD") { $content_head = $res->last_modified(); }
protocol("'$RM' -> " . $link_gg . " _SUCCESS_ REF('" . $ref_gg . "') '" . $res->status_line() . "' download Kbytes = '" . (length($content)/1024) . "'");
if ($USE_SPAM_METHOD eq "HEAD") { protocol("HEAD CHECK '". scalar(localtime($content_head)) ."'"); }
$R = 1;
} else {
if ($USE_SPAM_METHOD eq "GET") { protocol($link_gg . " error " . $res->status_line()); }
if ($USE_SPAM_METHOD eq "HEAD") { protocol($link_gg . " error " . $res->code()); }
$R = 0;
}
return $R;
}
############# FUNCTIONS ###############
1;
|
Признаки указываются в файле find.txt
| Код: |
"Powered by SMF 1.1" "Simple Machines"
stop
признак
признак
признак
|
Строка "stop", останавливает работу софта на стоп-строке, удобно, держать предыдущие признаки в том же файле, просто указывая стоп-строку.
Менее чем за 5 минут, с двух признаков, удалось собрать базу в 1000 строк.
Конечно, скрипт работает напрямую без прокси, много собрать не получится, но первичную базу по признакам, как сообщал, годится.
Локальный стартер, лично у меня реализован через bat файл, который в той же папке, название файла "do.bat", содержимое
| Код: |
|
D:\perl\bin\perl.exe do.pl %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
|
|
|
|
|
|
|
| Оффтоп: |
|
Для исключения ошибок при размещение-копирование содержимого тегов "Код", текст с них забирать с цитирования поста. Напротив поста, нажать "Ответить с цитатой".
|
|
|
|
|
|
|
Добрый день, подскажите в чем может быть дело?  Сделал всё по инструкции и тишина... Система х64 win 7, perl устанавливал по вашей ссылки для 64 битной версии. (сверялся при создании ещё с этим Софт для сбора линк-спам баз на perl
Заранее спасибо! |
|
|
|
|
|
usupekx, Active Perl поставил?
Перлу разрешение на выход в Сеть в брандмауэре стоит?
По сабжу - а сколько ссылок можно максимально спарсить разово, вида "inurl:smf.php?action=showtopics"?
Просто Гугл на такие запросы с использованием inurl очень быстро начинает выдавать капчу, в Бабочке уже через 100-300 результатов вылезает капча.
Спасибо. |
|
|
|
|
|
Я вообще на 32 битной версии XP, перл также "доисторический" все это запускал.
Хоть видно плохо, но никаких ошибок на экране нет.
Что там делает pause команда в bat файле, это видимо вы её сами поставили, чтобы показать мне, что ничего не происходит?
Трудно сказать что там может не работать.
Если нет никаких ошибок, скорее Яб прав, что то там блокирует работу каких то модулей перла.
Есть и в перл какая то инструкция, примерно как в php "error_reporting(E_ALL);", которая выводит все ошибки в процессе работы.
Обычно это видно по логам, если скрипт работает на удаленном хостинге под управлением *nix. В случае с win-ОС 7, делает ли она какие либо логи, этого я не знаю.
В любой случае, я должен знать, что там блокируется, и чего не хватает. |
|
|
|
|
|
ТС, скорее всего (не уверен, новозможно), если все установлено, то нужно дать права обращаться в сеть файлу do.pl (права на запуск), а также разрешить вести запись в файлы в той же папке, текстовые.
| Цитата: |
По сабжу - а сколько ссылок можно максимально спарсить разово, вида "inurl:smf.php?action=showtopics"?
Просто Гугл на такие запросы с использованием inurl очень быстро начинает выдавать капчу, в Бабочке уже через 100-300 результатов вылезает капча.
Спасибо.
|
Запросы inurl, он вроде уже на второй третий раз дает каптчу.
inurl-ы нужны для http://www.armadaboard.com/viewtopic.php?t=46768 только чтобы создать базу по которой будет идти сбор.
Я где то давал нужные запросы для сбор баз с одного ИП.
Софт для сбора линк-спам баз на perl.
Вернее алгоритм их составления.
| Цитата: |
| "нужное слово" "название форума (powered by phpbb версия)"
|
| Цитата: |
| "нужное слово" "название форума (powered by phpbb версия)"
|
Тот же гугль, стоит ввести запрос выдаст все возможные версии движка.
| Цитата: |
| "нужное слово" "название форума (powered by simple machines forum)"
|
"нужное слово" можно поставить как название таблетки, чтобы собрать форумы, которые без модерации, спамятся они пока не будет overflow базы.
Или же, выбрать по своему усмотрению.
Также, это пример только двух движков. |
|
|
|
|
|
| Скрытый пост. Для просмотра требуется 10 сообщений. |
|
|
|
|
|
| IseeDeadPeople писал(а): |
|
You need 10 posts to view this message
|
Спасибо, за оперативные ответы. Всё оказалось проще - не могу предположить с чем это связано: я правил файлы в notepad ++ и, соответственно, сохранял там файлы с расширениями .bat, .pl. Сделал всё ручками сейчас на нетбуке с xp 32bit в обычном блокноте. Вуаля, на 7ке 64bit без проблем запустилось. Спасибо ещё раз. Буду курить программу. 
P.S. Хочу напомнить тем, кто забыл как поменять расширение (применял на Xp) - снимаем галочку с пункта "скрывать расширение с зарегистрированных типов файлов" и удаляем .txt и дописываем .bat, .pl etc. |
|
|
|
|
|
IseeDeadPeople, мне больше, чем 700 урлов нужно собрать, под нужные параметры отсеется очень много.
А можно к скрипту прикрутить капчу?
Или может есть такой софт с антигейтом, парсящий Гугл\Яндекс, а когда там вылезает капча, решающие ее через антигейт?
Спасибо. |
|
|
|
|
|
usupekx,
| Цитата: |
IseeDeadPeople писал(а):
You need 10 posts to view this message
|
Сорри за пост под хайдом. Но там чисто для Яба была инфа. Ничего секретного.
| Цитата: |
| Спасибо, за оперативные ответы. Всё оказалось проще - не могу предположить с чем это связано: я правил файлы в notepad ++ и, соответственно, сохранял там файлы с расширениями .bat, .pl. Сделал всё ручками сейчас на нетбуке с xp 32bit в обычном блокноте. Вуаля, на 7ке 64bit без проблем запустилось. Спасибо ещё раз. Буду курить программу.
|
Удачи. Но учитывайте, что с одного ИП много баз не соберешь.
Я тогда их собирал в основном для http://www.armadaboard.com/viewtopic.php?t=46768&start=0 Поэтому 700 строк, мне было достаточно. |
|
|
|
|
|
| Yabuti писал(а): |
IseeDeadPeople, мне больше, чем 700 урлов нужно собрать, под нужные параметры отсеется очень много.
А можно к скрипту прикрутить капчу?
Или может есть такой софт с антигейтом, парсящий Гугл\Яндекс, а когда там вылезает капча, решающие ее через антигейт?
Спасибо.
|
К сожалению, всегда её использовал для сбора баз до 1к. Задачи за короткое время собрать больше, не было.
| Цитата: |
| А можно к скрипту прикрутить капчу?
|
У меня нет идей как это сделать, тем более софт на перл. Вряд ли получиться. Даже если у них есть API для perl. Я не уверен что получиться его подключить.
| Цитата: |
| Или может есть такой софт с антигейтом, парсящий Гугл\Яндекс, а когда там вылезает капча, решающие ее через антигейт?
|
Точно не знаю, но у ботмастера, парсер их, возможно умеет это делать. |
|
|
|
|
|
Вот еще причина не работоспособности.
Смотрите где вы поставили перл и сравните путь с бат файлом.
Может причина и в это была, иным знать тоже нужно. |
|
|
|
|
|
IseeDeadPeople, Спасибо большое за информативные посты, и особенно за пони-перлы  |
|
|
|
|
|
На здоровье. 
Раз уж подняли топик, сейчас проверю работоспособность.
Работает.
Если не знаете, чтобы вам не искать, по линку каталог моего иного софта на перле для работы с ПС, и не только. |
|
|
|
|
|
|
|
|
