Парсер мета-тегов и заголовков

[glGizma]

Исходник delphi программы, предназначенной для парсинга (извлечения) тегов title и значений в тегах. К примеру, можно извлечь информацию о гиперссылках, картинках, мета тегах, скриптах, иконок и т.п.
Рядом с программой нужно создать файл: urls.txt и вписать ссылки url

Бросаем на форму:
1) ListView1
2) Memo1
3) Button1
4) IdHTTP1
5) IdServerIOHandlerSSLOpenSSL1

Код: Выделить всё

  private
    procedure ParseHTML(const URL, HTML: string);
    procedure AddListItem(const URL, Title: string; Color: TColor);

Код: Выделить всё

procedure TForm2.Button1Click(Sender: TObject);
var
  HTTP: TIdHTTP;
  SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
  URLList: TStringList;
  i: Integer;
begin
  HTTP := TIdHTTP.Create(nil);
  SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  URLList := TStringList.Create;
  memo1.Clear;
  ListView1.Clear;
  try
    SSLHandler.SSLOptions.Method := sslvTLSv1_2;
    HTTP.IOHandler := SSLHandler;
    HTTP.HandleRedirects := True;

    // Загружаем URL из файла
    URLList.LoadFromFile('urls.txt');

    ListView1.Items.BeginUpdate;
    try
      for i := 0 to URLList.Count - 1 do
      begin
        try
          // Выполняем запрос к каждому URL
          ParseHTML(URLList[i], HTTP.Get(URLList[i]));
        except
          on E: EIdHTTPProtocolException do
          begin
            if E.ErrorCode = 302 then
            begin
              // Обработка перенаправлений
            end
            else if Pos('<title>404 Not Found</title>', E.Message) > 0 then
            begin
              // Страница не существует
              AddListItem(URLList[i], 'Страница не существует', clYellow);
            end
            else
              memo1.Lines.Add('Ошибка при получении страницы: "' + URLList[i] +'" '+ E.Message);
              //ShowMessage('Ошибка при получении страницы: ' + E.Message);
          end;
          on E: Exception do
            ShowMessage('Ошибка: ' + E.Message);
        end;
      end;
    finally
      ListView1.Items.EndUpdate;
    end;
  finally
    HTTP.Free;
    SSLHandler.Free;
    URLList.Free;
  end;
end;

Код: Выделить всё

procedure TForm2.ParseHTML(const URL, HTML: string);
var
  TitleStart, TitleEnd: Integer;
  Title: string;
  ListItem: TListItem;
begin
  TitleStart := Pos('<title>', HTML);
  TitleEnd := Pos('</title>', HTML);
  if (TitleStart > 0) and (TitleEnd > TitleStart) then
  begin
    Title := Copy(HTML, TitleStart + Length('<title>'), TitleEnd - TitleStart - Length('<title>'));
    AddListItem(URL, Title, clNone);
  end;
end;

Код: Выделить всё

procedure TForm2.AddListItem(const URL, Title: string; Color: TColor);
var
  ListItem: TListItem;
begin
  ListItem := ListView1.Items.Add;
  ListItem.Caption := URL;
  ListItem.SubItems.Add(Title);
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  if Color <> clNone then
  begin
    ListItem.SubItems[1] := 'Страница не существует';
    ListItem.SubItems[1] := '';
    ListItem.SubItems[2] := '';
    ListItem.SubItems[3] := '';
    ListItem.SubItems[4] := '';
    ListItem.SubItems[5] := '';
    ListItem.SubItems[6] := '';
    ListItem.SubItems[7] := '';
    ListItem.SubItems[8] := '';
    ListItem.SubItems[9] := '';
    ListItem.SubItems[10] := '';
    ListItem.SubItems[11] := '';
    ListItem.SubItems[12] := '';
  end;
end;