Форум АНТИЧАТ - Cкрипт для отсеивания мыл

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)

- PHP, PERL, MySQL, JavaScript (https://forum.antichat.xyz/forumdisplay.php?f=37)

- - Cкрипт для отсеивания мыл (https://forum.antichat.xyz/showthread.php?t=48080)

Cкрипт для отсеивания мыл

ку
встеретился с такй проблемой, есть тхт файл в нём станицы в которых мыла .не подскажете скрипт желательно на перле для отсеивания мыл с страниц типа парсера,может я не внимательно искал но вроди не нашол на форуме)
спс

что-то невразумительное ))
а по просче есть?хотя идея ясна

Написал небольшой скрипт, по-прежнему не работает с двойными доменами (user@company.net.ua), но с обычными вроде норм, протестируйте плз)

PHP код:


		
			
<?php

    if (!isset($fname))

    {

        print "<form method='post'>Plz print the filename:<br/><input type='text' name='fname' length='15' maxlength='20'/><br/>";

        print "<input type='submit' name='go' value='go'></form><br/><br/>";

    }

    else

    {

        $i=0;

        $fname = $_POST['fname'];

        $error = "Cannot open file $fname. <br> <a href='javascript:history.go(-1);'>Get Back</a>";

        $file = file_get_contents($fname) or die ($error);

        $pattern = "/([a-z_-]+@([a-z][a-z-]*\.)+([a-z]{3}|ru|com|net|org|gov|edu|mil|info|biz|cc|net.ua|com.ua|org.ua|org.ru|com.ru|net.ru|spb.ru))/im";

        preg_match_all($pattern, $file, $ok);

        while (@$ok[0][$i])

        {

            print $ok[0][$i]."<br>";

            $i++;

        }

    }

?>

Дети мои...

PHP код:


		
			
preg_match("|[-0-9a-z_\.]+@[-0-9a-z_^\.]+\.[a-z]{2,6}|i", $email, $out);
  echo $out[0];

эффективнее же искать до первого пробела или переноса строки до и после собаки, и тогда не будет проблем с двойными и более доменами :)

Цитата:

Сообщение от ant0ha

тоже не лучший вариант)
представь себе, что мыла, предположим, в таком формате:

PHP код:


		
			
<a href='mailto:blablabla'>email</a><br>

у меня в мыслях только 2 варианта: чтение до символа, не входящего в диапазон буквы_цифры, либо чтение до последней точки.. как реализовать второе - не знаю :(

вот тут глянь http://forum.antichat.ru/showpost.php?p=290912&postcount=44

а вот на перле от Genom

PHP код:


		
			
#!/usr/bin/perl



if (@ARGV==0) { print "\n###########Genom Spam List Bilder v1.3##################\n\nUse: perl spam-bilder.pl /start_folder/\n"; exit;};



$asd=@ARGV[0]; 

$i=0;

$a=1;

@dir[0]=@ARGV[0];

opendir FF, $asd;

while ($zz=readdir FF) {

$aa=$zz=~m/\./;

 if ($aa==0) {if ($asd=="/") {@dir[$i]="$asd$zz";$i++;}else{@dir[$i]="$asd/$zz";$i++;} }  

closedir dir;}



papki(@dir[$a]);

for $qq (@dir){print "$qq\n"}; # убери в начале решетку если хочешь чтобы выводились найденные папки



##################рекурсивная функция которая забивает пути к папкам в массив @dir ##################

sub papki {

opendir FF,@dir[$a];

while ($zz=readdir FF) {

$aa=$zz=~m/\./;

 if ($aa==0) {@dir[$i]="@dir[$a]/$zz";$i++;}  };

closedir dir;$a=$a+1;



if ($a<$i) {papki(@dir[$a]);}

};@dir[$a];

###########################функция поиска файлов################



# получаем имена всех файлов в обнаруженных папках и заносим их в массив @file

# под категорию файлов подпадают объекты в именах которых есть точка--- так что некоторые папки может 

# не обработать(то есть признает их файлами)- это связано с тем что пишу под виндой и параметры 

# распознования файлов линукса -e и -f у меня почемуто не работают =( ---

$xy=0;



for $qqq (@dir){

opendir FF, $qqq;

while ($zz=readdir FF) {

if (length($zz)>2) {

$aa=$zz=~m/\./;

 if ($aa==1)  {@file[$xy]="$qqq/$zz";$xy++;} }

closedir dir;}

};

for $wer (@file){print "$wer\n"};# убери в начале решетку если хочешь чтобы выводились найденные 

# файлы 



######## функция выдирания из найденных фалов e-mail адресов



open mail,">new-mail.txt";



for $syka (@file){

open piska, "<$syka";

while ($zzaa=<piska>)

{if ($zzaa =~m/\b([\w\d]+\@[\w\d]+\.[\w\d\.]+)\b/g) { $list{"$1"}="";}}}

 





$,="\n";

print mail keys %list;

close mail;

мыло отделено от остального хтмл пробелами или <, если оно там еще чем то может быть отделено, то этот символ надо вставить в [ |>] через |
#!/usr/bin/perl

open (html, '<file.txt');
open (mila, '>mila.txt');
while (<html>) {
if ($_ =~ /[ |>](.+@.+.\w+)[ |<]/gi) {
print mila "$1\n";
}
}
close html;
close mila;

тоже довольнотаки часто встречается:

 mail@site.ru 