idHttp, парсинг, томрожение

[_ZixeL_]

Доброго времени суток, формучане. Прошу помощи.
В общем, имеем 2525 страниц с пользователями. На каждой странице по 20 пользователей. Требуется быстренько спарсить всех пользователей со всех страниц. Кусок ХТМЛ кода такой:
(не хочу выкладывать сылку, дабы не было рекламы))

<h3 class="username"><a href="members/20940/" class="username StatusTooltip NoOverlay" title="Сижу в интернете">Nickname</a></h3>

Написал код, он работает нормально. Проблема в том, что со временем начинает затормаживать.Изначально парсит первые 100 страниц за пол минуты, потом каждую страницу 1 секунду. И не могу понять в чём проблема. Всё это дело в отдельном потоке.

Вот код. Посмотрите пожалуйста:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    RichEdit1: TRichEdit;
    ProgressBar1: TProgressBar;
    IdHTTP1: TIdHTTP;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;


  TNewThread = class(TThread)
  private
  protected

    procedure ParsList;
    procedure Execute; override;
  public

    constructor Create(CreateSuspended: Boolean);
  end;


function Pars(T_, ForS, _T:string):string;

var
  Form1: TForm1;
    users,page,list,strok:Tstringlist;
    i:integer;
    ft : TextFile;

implementation

{$R *.dfm}


//Парсинг-----------------------------------------------------------------------
function Pars(T_, ForS, _T: string): string;
var
  a, b: integer;
begin
  Result := '';
  if (T_ = '') or (ForS = '') or (_T = '') then
    Exit;
  a := Pos(T_, ForS);
  if a = 0 then
    Exit
  else
    a := a + Length(T_);
  ForS := Copy(ForS, a, Length(ForS) - a + 1);
  b := Pos(_T, ForS);
  if b > 0 then
    Result := Copy(ForS, 1, b - 1);
end;
//Парсинг-----------------------------------------------------------------------

constructor TNewThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
    TNewThread.Create(false);
end;

procedure TNewThread.ParsList;
begin
   for I :=0 to page.Count-1 do
   begin
    users.Add(Pars('username"><a href="', page.Strings[i], 'a>'));

   end;

     for i:=users.Count-1 downto 0 do
   begin
    if users.Strings[i]='' then
       users.Delete(i);
   end;

     for I :=0 to users.Count-1 do
   begin
    list.Add(Pars('">', users.Strings[i], '</'));
    Form1.RichEdit1.Lines.Add(list.Strings[i]);
    Form1.Label1.Caption:=inttostr(Form1.RichEdit1.Lines.Count);
   end;

end;


procedure TNewThread.Execute;
var b:integer;
 begin


  for I := 1 to 2525 do
  begin
   users:=Tstringlist.Create;
   page:=Tstringlist.Create;
   list:=Tstringlist.Create;
   b:=b+1;
   page.Text:=Form1.idHTTP1.Get('http://mypage.ru/members/?page='+inttostr(b));

    ParsList;

    users.clear;
    list.clear;
    page.clear;

  end;
 end;




procedure TForm1.FormCreate(Sender: TObject);
begin
ProgressBar1.Max:=50500;
end;

end.

Пробовал так же сразу (пере)записывать в тхт файл. Проблема та же.
Буду благодарен за любую помощь.

[Аватар]

Что сразу бросилось в глаза - утечки памяти - 2525 раз создается 3 стриглиста без освобождения памяти. Остальное даже смотреть не стал

[eoln]

А ещё синхронизации нет (а зачем вообще тут поток, можно и без него прекрасно обойтись). В случае одного потока можно положиться на "авось пронесёт", а при 2-х и более это точно фатально будет.

[_ZixeL_]

Сообщение от Аватар

Что сразу бросилось в глаза - утечки памяти - 2525 раз создается 3 стриглиста без освобождения памяти. Остальное даже смотреть не стал

Вместо clear использую free. Немного не тот код выложил.

А ещё синхронизации нет (а зачем вообще тут поток, можно и без него прекрасно обойтись). В случае одного потока можно положиться на "авось пронесёт", а при 2-х и более это точно фатально будет.

Просто форма подвисает, мне это не надо.
Как я знаю, синхронизация нужна только между потоками. А у меня тут один поток. Или я ошибаюсь?

[eoln]

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

Как я знаю, синхронизация нужна только между потоками. А у меня тут один поток.

Строго говоря 2 потока - основной (сама программа) и дочерний (создаётся по TNewThread.Create). При обращении из дочернего потока к vcl (форма, компоненты) надо обязательно синхронизировать.
ИМХО, лучше всего в потоке не иметь ничего общего с формой и компонентами до завершения работы. IdHTTP создать динамически, а добавление в ричедит и лэйбл синхронизировать. В этом случае можно параллельно запустить несколько потоков; на поведение формы это влиять не будет, надёжность резко возрастёт, скорость тоже может повысится (этот факт индивидуален для каждого отдельного случая)

[_ZixeL_]

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

Строго говоря 2 потока - основной (сама программа) и дочерний (создаётся по TNewThread.Create). При обращении из дочернего потока к vcl (форма, компоненты) надо обязательно синхронизировать.
ИМХО, лучше всего в потоке не иметь ничего общего с формой и компонентами до завершения работы. IdHTTP создать динамически, а добавление в ричедит и лэйбл синхронизировать. В этом случае можно параллельно запустить несколько потоков; на поведение формы это влиять не будет, надёжность резко возрастёт, скорость тоже может повысится (этот факт индивидуален для каждого отдельного случая)

Пробовал динамически создавать IdHTTP. Проблема была та же.
Можно поподробней про синхронизацию? А то не очень понятно, как синхронизировать добавление в ричедит.

Сделал как Вы посоветовали. Ничего общего с формой и компонентами. Создал динамически IdHTTP и лейбл. Убрал ричедит. Смотрю по лэйблу какая скорость парсинга страниц. И проблема всё та же. Со временем затормаживается.

  TNewThread = class(TThread)
  private
  protected

    procedure ParsList;
    procedure Execute; override;
  public
    IdHTTP1: TIdHTTP;
    Label1:Tlabel;
    users,page,list,strok:Tstringlist;
    constructor Create(CreateSuspended: Boolean);
  end;

procedure TNewThread.Execute;
var b:integer;
 begin
   label1:=Tlabel.Create(form1);
   label1.Parent:=Form1;
   Label1.Top:=520;
   Label1.Left:=10;

  for I := 1 to 2525 do
  begin
   idhttp1:=Tidhttp.Create(nil);

   users:=Tstringlist.Create;
   page:=Tstringlist.Create;
   list:=Tstringlist.Create;
   b:=b+1;
   page.Text:=idHTTP1.Get('http://rus-minecraft.ru/members/?page='+inttostr(b));
   Label1.Caption:='Page: ' +inttostr(b);
   ParsList;


    FreeAndNil(users);
    FreeAndNil(list);
    idhttp1.Free;
  end;
 end;

Может ли быть, что проблема у меня? Ну там, типа забивается канал или что-то в этом роде?

[eoln]

page не освобождается.
label не надо создавать в потоке
К тому же, создавать и освобождать надо вне цикла, в самом цикле только clear оставить
Проверить может сервер шлёт за слишком частые запросы.
Про synchronize можно почитать в сети

[_ZixeL_]

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

page не освобождается.
label не надо создавать в потоке
К тому же, создавать и освобождать надо вне цикла, в самом цикле только clear оставить
Проверить может сервер шлёт за слишком частые запросы.
Про synchronize можно почитать в сети

page освобождал тут:

procedure TNewThread.ParsList;
var i:integer;
begin
   for I :=0 to page.Count-1 do
   begin
    users.Add(Pars('username"><a href="', page.Strings[i], 'a>'));

   end;

   FreeAndNil(page);
   for i:=users.Count-1 downto 0 do
   begin
    if users.Strings[i]='' then
       users.Delete(i);
   end;

     for I :=0 to users.Count-1 do
   begin
    list.Add(Pars('">', users.Strings[i], '</'));


   end;

end;

Сделал как сказали. Создание и освобождение вне цикла. Проблема всё та же.

К сожалению, я не знаю как проверить что сервер шлёт. Включил http analyzer и увидел, что duration(s) увеличивается. Тоесть, как я понял, время загрузки страницы увеличивается. Где первый Гет запрос загрузился за 0,375s, где 200ый - за 1,702s

[_ZixeL_]

Ребят, больше никто ничего не может посоветовать?
Выручайте, а то не знаю что делать)

[Slym]

размножай потоки... одного мало... 10-30 в самый раз