Показать сообщение отдельно
  #1  
Старый 30.09.2015, 22:27
Avenger15 Avenger15 вне форума
Прохожий
 
Регистрация: 17.09.2015
Сообщения: 10
Версия Delphi: Delphi XE3
Репутация: 10
Сообщение Помощь по многопоточности

Прошу у вас помощи.
Суть такова: Создаются 5 потоков с таким вот кодом
Код:
procedure Searcher.Execute;
var
  i: integer;
begin
  FHTTPS := THTTPSend.Create;
  FLIST := TStringList.Create;
  FHTML := TStringList.Create;
  FRegExp := TRegExpr.Create;
  try
    for i := 0 to 5 do
    begin
      setheaders;
      FHTTPS.HTTPMethod('GET', URL + inttostr(i));
      begin
        FHTML.Clear;
        FHTML.LoadFromStream(FHTTPS.Document, TEncoding.UTF8);
          if pos('<steamID64>', FHTML.Text) > 0 then
          begin
            FRegExp.Expression := '<steamID64>(.*?)</steamID64>';
            if FRegExp.Exec(FHTML.Text) then
              repeat
               FLIST.Add(FRegExp.Match[1]);
              until not FRegExp.ExecNext;
        end;
      end;
    end;
  finally
    FreeAndNil(FHTTPS);
    FreeAndNil(FLIST);
    FreeAndNil(FHTML);
    FreeAndNil(FRegExp);
  end;
end;

Проблема: Дело в том , что эти 5 потоков выполняют одно и тоже действие.
Вопрос: Как сделать так , чтобы действия не повторялись а улучшилась скорость?
То есть , если всё делать в один поток , работа будет медленной , я специально сделал многопоток чтобы улучшить скорость , вообщем создаётся 5 потоков но действие повторяется , мне нужно чтобы эти 5 потоков выполняли одно действие только быстро , то есть как один поток , но при этом скорость была больше.
Вот весь код:

Код:
type
  Searcher = class(TThread)
  private
    FHTTPS: THTTPSend;
    FLIST, FHTML: TStringList;
    FRegExp: TRegExpr;
  protected
    procedure Execute; override;
    procedure setheaders;
  public
  end;

var
  Form1: TForm1;
  URL: string;
  Th: array [0 .. 5] of TThread;

implementation

{$R *.dfm}
{ Searcher }

procedure Searcher.Execute;
var
  i: integer;
begin
  FHTTPS := THTTPSend.Create;
  FLIST := TStringList.Create;
  FHTML := TStringList.Create;
  FRegExp := TRegExpr.Create;
  try
    for i := 0 to 5 do
    begin
      setheaders;
      FHTTPS.HTTPMethod('GET', URL + inttostr(i));
      begin
        FHTML.Clear;
        FHTML.LoadFromStream(FHTTPS.Document, TEncoding.UTF8);
          if pos('<steamID64>', FHTML.Text) > 0 then
          begin
            FRegExp.Expression := '<steamID64>(.*?)</steamID64>';
            if FRegExp.Exec(FHTML.Text) then
              repeat
                FLIST.Add(FRegExp.Match[1]);
              until not FRegExp.ExecNext;
        end;
      end;
    end;
  finally
    FreeAndNil(FHTTPS);
    FreeAndNil(FLIST);
    FreeAndNil(FHTML);
    FreeAndNil(FRegExp);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Threads: integer;
begin
  URL := Edit1.Text + '/memberslistxml/?xml=1&p=';
  for Threads := 0 to 4 do
  begin
    Th[Threads] := Searcher.Create;
    Th[Threads].FreeOnTerminate := true;
  end;
end;

procedure Searcher.setheaders;
begin
  with FHTTPS do
  begin
    Document.Clear;
    Headers.Clear;
    KeepAlive := true;
    Headers.Add('Accept: */*');
    Headers.Add('Accept-Language: ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4');
    Headers.Add('Accept-Charset: utf-8;q=0.7,*;q=0.3');
    UserAgent :=
      'Mozilla/5.0 (Windows NT 6.2; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/30.0.1599.17 Safari/537.36';
  end;
end;
Ответить с цитированием