Многократное использование потоков(пул потоков)

[ProgrammistRT]

Доброго времени суток всем!
В первый раз использую потоки в Делфи, и возникли кой какие сложности. Помогите пжлст люди добрые.)
Не могу организовать работу потоков в цикле. Для примера взял парсинг интернет страничек. Пользователь указывает кол-во потоков для парсинга, и дает список урлов, которые надо спарсить. Когда потоков больше урлов (или равно), у меня легко получается) А когда их меньше, ни как как только не пытался.
Видимо, что то делаю не правильно. Попробовал разными способами, вот два из них:

В Edit1 кол-во потоков, в Memo9 список урлов для парсинга, Memo1 для вывода, Button1Click - начало процесса

1. Потоки создаются, и уничтожаются после выполнения задания. Пытался без уничтожения, используя Suspend,
но не получается все равно достичь желаемого.

var  bb,aa,FInt1,kpotok: integer;
strg: string;
  Form1: TForm1;
  MyThread: TMyThread;
  TMyThreadArray: array of TMyThread = nil;  //   массив потоков
  Tflag: array of Boolean = nil;             //   массив состояний потоков
  section: TCriticalSection;


implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var x,z: Integer;
begin
kpotok := StrToInt(Edit1.Text);
SetLength(Tflag, kpotok);
SetLength(TMyThreadArray, kpotok);
for x := 0 to High(TFlag) do TFlag[x] := false;
section := tcriticalsection.create;

z := 0;
for x := 0 to Memo9.Lines.Count-1 do  // В Memo9 список для парсинга
begin
  while TFlag[z] <> false do    //цикл поиска свободного потока
  begin                         //
  z := z + 1;                   //
  //sleep(100);
  if z = kpotok then z := 0;    //
  //if TMyThreadArray[z].Terminated = false then TFlag[z] := true;
  end;

 TMyThreadArray[z]:=TMyThread.Create(True);
 TMyThreadArray[z].FreeOnTerminate:=True;
 TMyThreadArray[z].Priority:=tpLower;
 TMyThreadArray[z].FInt0 := 1;
 TMyThreadArray[z].FInt := x;
 TMyThreadArray[z].FInt2 := z;
 TFlag[z] := true;
 TMyThreadArray[z].Resume;
end;    // for x := 0 to Memo9.Lines.Count-1 do

end;


procedure TMyThread.Execute;
var str,url: string;
    IdHTTP: TIdHTTP;
begin
  try                                        // парсинг
  url := Form1.Memo9.Lines[FInt];
  IdHTTP := TIdHTTP.Create(nil);
  Str := idHttp.Get(url);
  finally
  IdHTTP.Free;
  end;

 section.enter;                       // критическая секция, вывод в memo1
 strg := str;
 Synchronize(SetProgress);
 section.leave;
TFlag[FInt2] := false;             // сброс флага

end;


procedure TMyThread.SetProgress;
begin
 Form1.Memo1.Lines.Add(strg);
end;

2. Потоки создаются при открытии приложения, создается так же массив флагов к ним. Потоки активируются,
при установке их флага в true.

var  kpotok: integer;
     strg: string;
  Form1: TForm1;
  MyThread: TMyThread;
  TMyThreadArray: array of TMyThread = nil;
  Tflag: array of Boolean = nil;
  section: TCriticalSection; // глобальная переменная



implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
kpotok := StrToInt(Edit1.Text);
SetLength(Tflag, kpotok);
SetLength(TMyThreadArray, kpotok);
{for i := 0 to High(TMyThreadArray) do
                    TMyThreadArray[i]:=TMyThread.Create(False);}
for i := 0 to High(TFlag) do TFlag[i] := false;


for i := 0 to High(TMyThreadArray) do
begin
 TMyThreadArray[i]:=TMyThread.Create(False);
// TMyThreadArray[i].FreeOnTerminate:=false;
 TMyThreadArray[i].Priority:=tpLower;
  TMyThreadArray[i].FInt0 := 0;
 TMyThreadArray[i].FInt := 0;
 TMyThreadArray[i].FInt2 := i;
 TFlag[i] := false;
 TMyThreadArray[i].Resume;
end;


section := tcriticalsection.create;
end;



procedure TForm1.Button1Click(Sender: TObject);
var x,z: Integer;
begin

z := 0;
for x := 0 to Memo9.Lines.Count-1 do
begin
   while TFlag[z] <> false do    //цикл поиска свободного потока
   begin
   z := z + 1;
   sleep(100);
   if z = kpotok then z := 0;
   end;
 TMyThreadArray[z].FInt0 := 1;
 TMyThreadArray[z].FInt := x;
 TMyThreadArray[z].FInt2 := z;
 TFlag[z] := true;
end;



procedure TMyThread.Execute;   // поток, парсит html страничку и добавляет содержимое в memo1
var str,url: string;
    IdHTTP: TIdHTTP;
begin

while 1<>0 do
 begin
 if TFlag[FInt2] = true then
 begin
   try                                           // парсинг
   url := Form1.Memo9.Lines[FInt];
   IdHTTP := TIdHTTP.Create(nil);
   Str := idHttp.Get(url);
   finally
   IdHTTP.Free;
   end;

 section.enter;                             // критическая секция, вывод в memo1
 strg := str;
 Synchronize(SetProgress);
 section.leave;

 TFlag[FInt2] := false;                 // сброс флага потока
 end;
end;

end;


procedure TMyThread.SetProgress;
begin
 Form1.Memo1.Lines.Add(strg);             // добавление в memo1 результат парсинга
end;

end.

[ProgrammistRT]

Еще пробовал реализовать с помощью общего счетчика, который при запуске потока +1, при закрытии -1. Когда счетчик=0, то запускаем потоки по новой. Так тоже не работает.

Наверно, можно сказать, что мне нужен некий пул потоков, скелет этого пула. Ребята, пжлст, поделитесь знаниями.

С уважением.

[Alter]

Что то типа этого?

[ProgrammistRT]

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

Что то типа этого?

вроде нет. Уж сколько дней борюсь с этими потоками, очень много вариантов перепробовал, экспериментировал. И только сейчас обнаружил, что потоки выводят результат своей работы, только после старта всех потоков. Окончательно мозг сломал.

Например:

for x := 0 to 4 do
begin
 TMyThreadArray:=TMyThread.Create(true);
TMyThreadArray.FreeOnTerminate:=true;
 TMyThreadArray.Priority:=tpLower;
 TMyThreadArray.FInt := x;
TMyThreadArray.Resume;
end;

    sleep(10000);

for x := 5 to 10 do
begin
 TMyThreadArray:=TMyThread.Create(true);
TMyThreadArray.FreeOnTerminate:=true;
 TMyThreadArray.Priority:=tpLower;
 TMyThreadArray.FInt := x;
TMyThreadArray.Resume;
end;

Потоки запускаются сразу после Resume, но, результат работы потоков (вывод данных в мемо через критическую секцию), происходит только после запуска всех потоков.

Сам поток и процедура вывода:

procedure TMyThread.Execute;
var str: string;
begin
str := 'Результат работы потока №' + inttostr(FInt);
section.enter;
 strg := str;
Synchronize(SetProgress);
section.leave;
end;

procedure TMyThread.SetProgress;
begin
 Form1.Memo1.Lines.Add(strg);
end;

Почему так происходит?

[ProgrammistRT]

Ребята, помогите пжлст, готов купить консультацию.

[evg_m]

for x := 0 to 4 do
begin
 TMyThreadArray:=TMyThread.Create(true);
TMyThreadArray.FreeOnTerminate:=true;
 TMyThreadArray.Priority:=tpLower;
 TMyThreadArray.FInt := x;
TMyThreadArray.Resume;
end;

    sleep(10000); ЗАМОРОЗИЛИ основной поток (тот который обрабатывает ВСЕ общение с VCL (в том числе и ОТОБРАЖЕНИЕ данных поступивших (!) в Memo

for x := 5 to 10 do
begin
 TMyThreadArray:=TMyThread.Create(true);
TMyThreadArray.FreeOnTerminate:=true;
 TMyThreadArray.Priority:=tpLower;
 TMyThreadArray.FInt := x;
TMyThreadArray.Resume;
end;
//после оттаивания запустились и остальные и ПОТОМ только пойдет обработка накопленных в мемо данных.

БЕЗ заморозки попробуйте порционный запуск потоков в таймере.

либо sleep(10000) заменить на

for j:=1 to 100 do
  sleep(100);
  application.ProcessMesaages;
end;

[ProgrammistRT]

evg_m, попробовал, не помогает. Вообще, этот слип не нужен, просто с помощью него я выявил проблему

[Sibedir]

Форма
Form1.jpg
Модуль формы

unit Unit1;

interface

uses
  ... (вырезал из-за ограничения поста по длине)

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Math;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize; // В программе для боловства использую Random
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  cT, iT, iL: Integer;
begin
  Form1.Enabled := False; // Там ниже есть "Application.ProcessMessages".
  // Поэтому лучше закрыть доступ к форме пока работа цикла не завершена.
  cT := StrToInt(Edit1.Text); // устанавливаем кол-во потоков
  uBeginning1 := GetTickCount; // фиксируем время начала работы
  // Установим начальные значения
  SetLength (MyThreadArray1, cT);
  SetLength (FlagArray1, cT);
  for iT := 0 to cT-1 do FlagArray1[iT] := False;
  Memo2.Lines.Clear; // Ну и очистим Memo

  iT := 0;
  for iL := 0 to Memo1.Lines.Count-1 do begin // В Memo1 список строк
    while FlagArray1[iT] do begin // Цикл поиска свободного потока
      Inc(iT);
      if iT = cT then iT := 0;
      Application.ProcessMessages; // Пока ищем, можно вывести накопившиеся
      // результаты. Если этого не сделать, программа зависнет на
      // "Synchronize (SetProgress)". То есть дочерние потоки будут ждать
      // обработки SetProgress и не сбросят флаги, а основной поток будет
      // бесконечно ждать, когда хотя бы один флаг сбросится. Жаль...
    end;
    MyThreadArray1[iT]:= TMyThread1.Create (iT, iL); // НЕСЧАДНО ПЛОДИМ ПОТОКИ !!!
    // Как будто нам заняться больше нечем.
  end;
  Form1.Enabled := True;
end;

end.

Модуль потока

unit MyThread1Unit;

interface

uses
  System.SysUtils, System.Classes;

type
  TMyThread1 = class (TThread)
  private
    class var
    FMyCounter: Integer;
  private
    FNum: Integer;
    FRealNum: Integer;
    FLine: Integer;
    FRes: string;
  protected
    class constructor Create;
    class function GetNumber: Integer; inline;
  public
    constructor Create (ANum, ALine: Integer);
    procedure Execute; override;
    procedure SetProgress;
  end;

var
  MyThreadArray1: array of TMyThread1;
  FlagArray1: array of Boolean;
  uBeginning1: Cardinal;

implementation

uses
  Unit1;

const
  _MAX_TIME_Of_WORK1 = 500;

procedure AsThoughDoSomething;
begin
  Sleep (Random (_MAX_TIME_Of_WORK1));
end;

{ TMyThread1 }

class constructor TMyThread1.Create;
begin
  FMyCounter := -1;
end;

class function TMyThread1.GetNumber: Integer;
begin
  Inc(FMyCounter);
  Result := FMyCounter;
end;

constructor TMyThread1.Create(ANum, ALine: Integer);
begin
  // Справка Delphi твердит нам о том, что отложенный запуск и Resume
  // придумали для отладчиков, а не для рабочего кода прогаммы. Не будем
  // с ней спорить.
  inherited Create;
  // Установим начальные значения
  FNum  := ANum ;
  FRealNum := GetNumber;
  FLine := ALine;
  FRes := ''; // надо бы обнулить
  FlagArray1[FNum] := True; //застолбим поток
  // прочая лабуда
  FreeOnTerminate := True;
  Priority := tpLower;
end;

procedure TMyThread1.Execute;
begin
  Sleep (Random (_MAX_TIME_Of_WORK1)); // Как будто что-то делаем

  FRes := IntToStr(FNum) + #9 + IntToStr(FRealNum) + #9 + IntToStr(FLine) + #9 + IntToStr(GetTickCount-uBeginning1);
  Synchronize (SetProgress); // Вы 'нарвались' на необходимость использовать
  // Synchronize засунув "Form1.Memo12.Lines.Add (FRes)" в тело дочерннего
  // потока, а этот самый Memo принадлежит объекту основного потока.
  // Вот какая печалька.
  FlagArray1[FNum] := False; // сброс флага
  // ВНИМАНИЕ!!! С этого момента поток в свободном плавании, ведь флаг уже
  // сброшен, а сам поток еще существует. В данном случае это не страшно,
  // т.к. FreeOnTerminate = True, но обратить внимание стоит.
end;

procedure TMyThread1.SetProgress;
begin
  Form1.Memo2.Lines.Add (FRes);
end;

end.

Результат
Имеем то, что имеем. Работает. Эт хорошо. Но...

Поток	Реально	Строка	Время
0	0	0	78
2	2	2	234
0	5	5	437
3	3	3	437
1	1	1	469
4	4	4	469
2	6	6	469
3	8	8	750
0	7	7	890
1	9	9	937

Реально для обработки 10 строк было создано 10 потоков. Эт плохо.
Сегодня уже пора спать. Завтра попробую добить тему своим генеальным кодом

[Lardes]

ProgrammistRT, не обязательно использовать "пул потоков" =) Проще для каждого потока выделить определенную часть списка ссылок для парсинга.

http://www.programmersforum.ru/showthread.php?t=223574

Обратите внимание на #12 пост

[opencloser]

Как бы сделал я, все общии ресурсы вынес с отдельную структуру(может класс с методами для их управления), В главном потоке объявил бы критическую секцию(использовал бы ее для редактирования общих данных), далее сделал бы всего один поток, отладил бы всю программу считая его единым потоком, а потом как все заработало, то доделал бы управление потоками.
По вашему коду, могу сказать, что синхронизация используется некорректно, легко может привести к тупикам. Вам как минимум необходимо прочитать про потоки и узнать что такое их состояния.
и еще строчки вида while 1<>0 do не должны присутствовать в потоках, т.к. это не даст вам надежного(корректного) завершения потока.