Прежде чем начать хотелось бы сразу обратить внимание, что данная статья содержит лишь ознакомительный характер и не предназначена для получения базы E-mail адресов в корыстных целях(Spam‘a). Хотя  в целом, наша программа спокойно может бродить по просторам интернета без нашего вмешательства и собирать ту или иную информацию, в моем случае это e-mail адреса. Итак для того чтобы приступить к изучению учебного материала, потребуется установленный пакет Indy или Synapse.

В своей программе я использовал следующие компоненты:

• TIdHTTP
• IdAntiFreeze

Остальные компоненты входят в стандартный набор Lazarus.

Для обеспечения производительности программы для работы с HTTP запросами, я создал отдельный класс. В результате чего теперь можно регулировать количество создаваемых потоков из самой программы.

Задумка была такова: Даем программе несколько начальных адресов сайтов. Программа заходит на эти адреса, ищет различные ссылки на другие сайты, а также e-mail адреса, проверяет их уникальность и записывает их. Для записи ссылок и E-mail я создал 2-ва Memo, чтобы избежать зависания программы, обращения к ним происходит через главный поток  с помощью Synchronize. Вынес StatusBar для отображения хода выполнения и в результате получил нечто следующие:

Как видно на картинках, с помощью компонента PageControl добавил 2-ве страницы. На первой странице: наша рабочая область, на второй: настройки для производительность нашей программы, а так же настройка прокси.

Весь исходный код описывать в статье не буду, готовую работу можно будет скачать в конце данной статьи. Разберем наиболее интересные части программы.

И так. На форме присутствует 2-ве кнопки. Первая это Start и вторая Х кнопка аварийно завершающая(убивающая) все потоки в программе.

Кнопка Start:

procedure TForm1.ButtonStartClick(Sender: TObject);
  var i:Integer;
begin
  CountURL:=0;                                   //Переменная которая говорит с какой ссылки начать
  SleepTimes:=StrToIntDef(EditSleep.Text,0);     //Время ожидания перед новым сайтом
  SetLength(T1,StrToIntDef(EditCountTh.Text,1)); //Колличество потоков
  For i:=0 to Length(T1) do
  begin
    T1[i]:=TGo.Create(False);                    //Создание потока
    T1[i].Priority:=tpLowest;                    //Приоритет потока
  end;
  ButtonStart.Enabled:=False;
end;

T1 описан выше как массив созданного мною класса потока. В коде имеет следующий вид:

TGO = Class(TThread)
  Private
    URL,NewURLs,         //Текущие адрес и новый адрес страниц 
    NewEmails:String;    //E-mail адрес
    Procedure GetURL;    //Ко всем процедурам ниже в программе обращаюсь через Synchronize
    Procedure IncURL;
    Procedure NewURL;
    Procedure NewEmail;
    Procedure StatusBar;
  Public
    procedure Execute; override;   //Основная процедура, запускается при создании потока.
  end;

var
  T1: array of TGO;     //Динамический массив. Размер определяем при нажатии на кнопку Start

Хочу обратить ваше внимание, что работать с динамическим массивом мы не можем, пока не определим его размер. Пока размер не определен, программа не выделяет под него место в памяти.

Для того чтобы остановить выполняющийся поток, нужно:

procedure TForm1.ButtonThreadStopClick(Sender: TObject);
  var i:integer;
begin
  for i:=0 to Length(T1) do
    KillThread(T1[i].Handle);    //Остановить работающие потоки
  ButtonStart.Enabled:=True;
end;

А теперь самая интересная часть, основной код процедуры потоков:

procedure TGO.Execute;
var
  Http:TidHttp;
  Result,ResultNewURL:String;
  i:Integer;
  S:String=''''; //Так мне было проще понять что я ищу. Здесь записана одинарная кавычка: '
begin
   try
     Http:=TIdHTTP.Create;
     http.ConnectTimeout:=StrToIntDef(Form1.EditHttpTime.Text,3)*1000;    //TimeOut соединения
     http.ReadTimeout:=StrToIntDef(Form1.EditHttpTime.Text,3)*1000;       //TimeOut соединения

     while Form1.CountURL<Form1.MemoURL.Lines.Count do   //Пока не последняя строка в Memo продолжаем.
       begin                                             //Строки постоянно добавляются....
         Synchronize(@GetUrl);                           //Обращаемся к Memo на форме для получения ссылки
           try
              Synchronize(@StatusBar);                  //Обновляем информацию
              Synchronize(@IncURL);                     //Увеличиваем счетчик ссылки
              Result:=http.Get(URL);                    //Получаем Html страницу
              ResultNewURL:=Result;                     //Дублируем ее для парсинга

              //Поиск Email
              while Ansipos('mailto:',Result)<>0 do
                begin
                  Delete(Result,1,Ansipos('mailto:',Result)+length('mailto:')-1);
                  I:=1;
                  While (Result[I]<>'>') and (Result[I]<>'?')
                       and (Result[I]<>'"') and (Result[I]<>S) do inc(I);
                  NewEmails:=copy(Result,1,I-1);
                  if pos(NewEmails,Form1.MemoEmail.Text)=0 then Synchronize(@NewEmail);  //Проверяем уникальность и добавляем емаил
                end;

             //Поиск ссылок
             while Ansipos('<a href=',ResultNewURL)<>0 do
                begin
                  Delete(ResultNewURL,1,Ansipos('<a href=',ResultNewURL)+length('<a href=')-1);
                  I:=2;
                  While (ResultNewURL[I]<>'>') and (ResultNewURL[I]<>'"') 
                        and (ResultNewURL[I]<>S) do inc(I);
                  I:=I-2;

                  if Copy(ResultNewURL,2,8)='https://' then Continue; //В данной программе я не стал реализовывать работу с https 
                  if Copy(ResultNewURL,2,7)='http://' then 
                    NewURLs:=copy(ResultNewURL,2,I) else
                        NewURLs:='http://'+http.URL.Host+'/'+copy(ResultNewURL,2,I);
                  if pos(NewURLs,Form1.MemoURL.Text)=0 then Synchronize(@NewURL);  //Аналогично емаил проверяем уникальность и добавляем в список.
                end;
          except
            //Битая ссылка. Можно удалять ссылку из мемо, но тогда она может вторично там появится
            //поэтому оставлю данный блок на ваше усмотрение.
          end;
        Sleep(SleepTimes*1000);    
      end;
  finally
     http.Free;
  end;
end;

Вот в принципе и все. Я описал основную часто программы. Далее вам остается лишь дописать процедуры по добавлению ссылок в список, обновлению информации о ходе выполнения и так по мелочи +)

С помощью данной программы можете попробовать написать свой поисковик(А ты создал свой Google?), сохраняя html страниц, после чего написать свой код поиска по сохраненным данным. 

Конечно это не полностью готовый проект, и в нем есть маленькие недочеты. Но я думаю вам не составит труда довести ее до ума. Если возникнут вопросы, буду рад помочь. 

Скачать исходники: E-mail to web