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

[_ZixeL_]

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

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

Вот как раз пытаюсь это реализовать. Проблема в том, что не знаю как синхронизировать потоки. Вроде делаю правильно, а оно по 5 раз выполняет один и тот же ГЕТ запрос.

Может кто подскажет? Целый день сижу гуглю. Перечитал кучу статей, но так догнать и не смог(

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;

    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  potok = class(TThread)
  private
   str: string;
   users,page,list,strok:Tstringlist;
   HTTP: TidHTTP;
  protected
    procedure Execute; override;
  public
    procedure synchro;
    constructor Create(CreateSuspended: Boolean);
  end;


var
  Form1: TForm1;
  nom, num:integer;
  a: array [1..100] of potok;
  CS:TcriticalSection;
implementation

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


{$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;

procedure potok.Execute;
var
i,b:integer;
begin
page:=Tstringlist.Create;
users:=TstringList.Create;
HTTP:=TidHTTP.Create(nil);
Sleep(100);

for i:=1 to 4 do
begin


page.Text:=HTTP.Get('http://rus-minecraft.ru/members/?page='+inttostr(i)+'/');

 for b:=0 to page.Count-1 do begin
  users.add(Pars('username StatusTooltip NoOverlay" title="">', page.Strings[b], '</a></h3>'));
 end;

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

page.Clear;
synchronize(synchro);

end;

end;


procedure potok.synchro;
begin
 inc(nom);
 Form1.Memo1.Lines.Add(users.text);
 Form1.Label2.Caption:=inttostr(nom);
 users.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var pot:integer;
begin
nom:=0;
 for pot:=1 to 5 do  begin
  a[pot]:=potok.Create(false);
 end;
end;




end.

[Lardes]

Вроде делаю правильно, а оно по 5 раз выполняет один и тот же ГЕТ запрос.

Если быть точнее, то по 4 раза.. Обрати внимание на свой код:

{ ... }
HTTP:=TidHTTP.Create(nil);
Sleep(100);

for i:=1 to 4 do //для чего тебе этот цикл?
begin


page.Text:=HTTP.Get('http://rus-minecraft.ru/members/?page='+inttostr(i)+'/');

{ ... }

end;

Просто создай переменные для каждого потока с какого по какой он должен загружать. Дели общее кол-во ссылок на потоке и для каждого потока назначай.

Далее:

procedure TForm1.Button1Click(Sender: TObject);
var pot:integer;
begin
nom:=0;
 for pot:=1 to 5 do  begin
  a[pot]:=potok.Create(false);
 end;
end;

Здесь тоже не всё хорошо

[_ZixeL_]

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

Если быть точнее, то по 4 раза.. Обрати внимание на свой код:

{ ... }
HTTP:=TidHTTP.Create(nil);
Sleep(100);

for i:=1 to 4 do //для чего тебе этот цикл?
begin


page.Text:=HTTP.Get('http://rus-minecraft.ru/members/?page='+inttostr(i)+'/');

{ ... }

end;

Цикл для одновренно-работающих потоков

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

Просто создай переменные для каждого потока с какого по какой он должен загружать. Дели общее кол-во ссылок на потоке и для каждого потока назначай.

Эмм, можно немного подробней, а то предложение "Дели общее кол-во ссылок на потоке и для каждого потока назначай." не совсем понятно.

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

procedure TForm1.Button1Click(Sender: TObject);
var pot:integer;
begin
nom:=0;
 for pot:=1 to 5 do  begin
  a[pot]:=potok.Create(false);
 end;
end;

Здесь тоже не всё хорошо

ЧТо именно?
Сорри, за глупые вопросы. Но серьёзно, никак не могу разобраться с потоками. Много статей перечитал, но везде пишут про один(!) дополнительный поток и как с ним работать. С этим понятно, но вот про многопоточность мало где нашёл статей, да и то там не понятно ничерта(

[Slym]

первые 10 тыс за 5 мин в 100 потоков
а так сервер тормозит

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    Index,MaxIndex,Threads:integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  TWorkThread = class(TThread)
  private
    Index:integer;
    users:Tstringlist;
  protected
    procedure Execute; override;
    procedure GetIndex;
    procedure UpdateUsers;
    procedure UpdateThreads;
  public
  end;


function Pars(const T_, ForS, _T: string): string;
var i: integer;
begin
  Result := '';
  if (T_ = '') or (ForS = '') or (_T = '') then
    Exit;
  i := Pos(T_, ForS);
  if i = 0 then Exit;
  i := i + Length(T_);
  Result := Copy(ForS, i, Length(ForS) - i + 1);
  i := Pos(_T, Result);
  if i > 0 then
    Result := Copy(Result, 1, i - 1);
end;

procedure TWorkThread.GetIndex;
begin
  if Form1.Index<=Form1.MaxIndex then
  begin
    Index:=Form1.Index;
    Inc(Form1.Index);
  end else
    Index:=-1;
end;

procedure TWorkThread.UpdateUsers;
begin
  Form1.Memo1.Lines.AddStrings(users);
  Form1.Caption:=IntToStr(Form1.Memo1.Lines.Count)+': Threads - '+ IntToStr(Form1.Threads);
end;

procedure TWorkThread.UpdateThreads;
begin
  Dec(Form1.Threads);
  if Form1.Threads<=0 then
    Application.MessageBox('All Threads Stops','',0);
end;

procedure TWorkThread.Execute;
var
  HTTP: TidHTTP;
  page: TStringlist;
  i,TryCount:integer;
begin
  users:=TstringList.Create;
  page:=Tstringlist.Create;
  HTTP:=TidHTTP.Create(nil);
  try
    while not Terminated do
    begin
      synchronize(GetIndex);
      if Index=-1 then Break;
      TryCount:=3;
      while TryCount>0 do
      try
        page.Text:=HTTP.Get('http://rus-minecraft.ru/members/?page='+IntToStr(Index)+'/');
        TryCount:=0;
      except
        dec(TryCount);
      end;
      users.Clear;
      for i:=0 to page.Count-1 do
      begin
        users.add(Pars('username StatusTooltip NoOverlay" title="">', page.Strings[i],'</a></h3>'));
      end;
      for i:=users.Count-1 downto 0 do
      begin
        if users.Strings[i]='' then
          users.Delete(i);
      end;
      synchronize(UpdateUsers);
    end;
  finally
    HTTP.Free;
    page.Free;
    users.Free;
  end;
  synchronize(UpdateThreads);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
  Thread:TWorkThread;
begin
  Memo1.Clear;
  MaxIndex:=2525;
  Index:=0;
  Threads:=100;
  for i:=1 to Threads do
  begin
    Thread:=TWorkThread.Create(true);
    Thread.FreeOnTerminate:=true;
    Thread.Resume;
  end;
end;

end.

[Slym]

13 минут 19тыс. юзеров 100 потоков
качает дальше
21 мин. 24тыс.

[_ZixeL_]

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

первые 10 тыс за 5 мин в 100 потоков
а так сервер тормозит

Оу, спасибо ОГРОМНОЕ.
Но у меня почему-то не работает.
Делфи ХЕ. В отладчике ошибка на строке

page.Text:=HTTP.Get('http://rus-minecraft.ru/members/?page='+IntToStr(Index)+'/');

First chance exception at $7513C6E3. Exception class EIdSocketError with message
'Socket Error # 10093
'.
Process Project2.exe (4596)

[Slym]

странно Socket error 10093 - Successful WSAStartup not yet performed
ужми потоки до 50

[_ZixeL_]

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

странно Socket error 10093 - Successful WSAStartup not yet performed
ужми потоки до 50

Пробовал, та же ошибка(

[Slym]

ну тогда принудительно WSAStartup в начале потока и WSACleanup в конце +Uses WinSock;

procedure TWorkThread.Execute;
var
  WSData:TWSAData;
  HTTP: TidHTTP;
  page: TStringlist;
  i,TryCount:integer;
begin

  WSAStartup(MakeWord(1,1),WSData);

  users:=TstringList.Create;
  page:=Tstringlist.Create;
  HTTP:=TidHTTP.Create(nil);
  try
    while not Terminated do
    begin
      synchronize(GetIndex);
      if Index=-1 then Break;
      TryCount:=3;
      while TryCount>0 do
      try
        page.Text:=HTTP.Get('http://rus-minecraft.ru/members/?page='+IntToStr(Index)+'/');
        TryCount:=0;
      except
        dec(TryCount);
      end;
      users.Clear;
      for i:=0 to page.Count-1 do
      begin
        users.add(Pars('username StatusTooltip NoOverlay" title="">', page.Strings[i],'</a></h3>'));
      end;
      for i:=users.Count-1 downto 0 do
      begin
        if users.Strings[i]='' then
          users.Delete(i);
      end;
      synchronize(UpdateUsers);
    end;
  finally
    HTTP.Free;
    page.Free;
    users.Free;
  end;
  WSACleanup;
  synchronize(UpdateThreads);
end;

[_ZixeL_]

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

ну тогда принудительно WSAStartup в начале потока и WSACleanup в конце

Ответь пожалуйста в ЛС.