Парсинг

Мне в голову пришла мысль спарсить анекдоты с сайта. Что бы вытащить несколько анекдотов будем работать с циклом, и удалять старый анекдот парсить новый и до тех пор, пока не закончится строка.

Заходим на страницу, смотрим между какими тегами будем парсить. 

1. <div class="text">
2. <table class="votingbox" border="0">

 Так мы нашли теги от куда мы будем брать наш текст, теперь напишем сам код.
Создадим функцию, назовем ParsingAnegdot объявим переменную GetTex в нее будет входит сам html код странице, результат будет типа String.

function TForm1.ParsingAnegdot(GetText: String): String;
begin

end;

Теперь нам осталось описать функцию чем мы сейчас и займемся.
 Объявим переменную Str тип String, там будет хранится результат(анекдота). Переменные p1,p2 тип Integer, будет хранится позиция тегов.

function TForm1.ParsingAnegdot(GetText: String): String;
var
 str: String; // Результат
 p1,p2: Integer; // Позиции поиска, Pos
begin
  repeat
   p1 := Pos('<div class="text">' ,GetText) + 18; // Позиция тега 1
   p2 := Pos('<table class="votingbox" border="0">', GetText); // Позиция тега 2
   Str := Copy(GetText,p1, p2 - Pos('<div class="text">' ,GetText) - 18 ); // Вытаскиваем под тегами, сам Анекдот
   Memo1.Lines.Add(Str); // Добавляем анекдот с новой строки
   Str := '';  // Обнуляем результат
   Delete(GetText,1,p2); // Удалеем с начала html кода, до конца позиции анегдота
  until Pos('<table class="votingbox" border="0">', GetText) = 0; // Ищим до тех пор пока теги найдены.

 // Удаляем все не нужные теги.
  Memo1.Lines.Text :=  AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text :=   AnsiReplaceText(Memo1.Lines.Text, '</div>', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<div class="site">', ' ');
  // Удаляем все не нужные теги.
end;

Функцию написана, надеюсь все понятно. Теперь на форму добавим компонент Memo, Кнопку Button, пожалуй все. Чуть не забыл компоненты IdHTTP1 и IdAntiFreeze1.

 Вот такая вот программка получилась у нас.  Полный код будет таков:

unit CLXMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, StrUtils;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure Button1Click(Sender: TObject);
    function ParsingAnegdot(GetText: String): String;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 GetText: String;
begin
 GetText := IdHttp1.Get('http://www.anekdot.ru/a/an1102/j110218;100.html');
 ParsingAnegdot(GetText);
end;

function TForm1.ParsingAnegdot(GetText: String): String;
var
 str: String; // Результат
 p1,p2: Integer; // Позиции поиска, Pos
begin
  repeat
   p1 := Pos('<div class="text">' ,GetText) + 18; // Позиция тега 1
   p2 := Pos('<table class="votingbox" border="0">', GetText); // Позиция тега 2
   Str := Copy(GetText,p1, p2 - Pos('<div class="text">' ,GetText) - 18 ); // Вытаскиваем под тегами, сам Анекдот
   Memo1.Lines.Add(Str); // Добавляем анекдот с новой строки
   Str := '';  // Обнуляем результат
   Delete(GetText,1,p2); // Удалеем с начала html кода, до конца позиции анегдота
  until Pos('<table class="votingbox" border="0">', GetText) = 0; // Ищим до тех пор пока теги найдены.

 // Удаляем все не нужные теги.
  Memo1.Lines.Text :=  AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text :=   AnsiReplaceText(Memo1.Lines.Text, '</div>', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<br />', ' ');
  Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, '<div class="site">', ' ');
  // Удаляем все не нужные теги.
end;
end.