Потоки, как ограничить количество?

[bakanaev]

Приветствую всех.
Начинаю работать с потоками.
У меня есть список урлов (url), 25 000.
По каждому из них надо пройтись и пропарсить.
Список загружаю в ListBox.
В моем коде получается так что количество поток = количеству ссылок в ListBox

procedure TForm2.Button1Click(Sender: TObject);
begin
 for I := 0 to ListBox1.Items.Count -1 do
   begin
   with TMyThread.Create(True) do
  begin
    URL := ListBox1.Items[i];
    FreeOnTerminate := True;
    Priority := TPNormal;
    Resume;
  end;

end;

Как сделать так что бы количество поток задавалось пользователем?




Вот код всей программы

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdCookieManager;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  type
      TMyThread = class(TThread)

      private
       FResultString: TStringList;
        { Private declarations }
      protected
        procedure Execute; override;
        procedure Update;
      public
      { Public declarations }
       URL : string;
      end;


var
  Form2: TForm2;
  MyThread: TMyThread;
   I : Integer;


implementation

{$R *.dfm}
//Процедура выдергивания строки между двумя заданными строками.........//
Procedure IsolateText( Const S: String; Tag1, Tag2: String; list: TStrings );
var pScan, pEnd, pTag1, pTag2: PChar; foundText: String;searchtext: String;
begin
  searchtext := Uppercase(S);
   Tag1:= Uppercase( Tag1 );
    Tag2:= Uppercase( Tag2 );
     pTag1:= PChar(Tag1);
      pTag2:= PChar(Tag2);
      pScan:= PChar(searchtext);
  repeat
  pScan:= StrPos( pScan, pTag1 );
    if pScan <> Nil then
      begin
       Inc(pScan, Length( Tag1 ));
        pEnd := StrPos( pScan, pTag2 );
        If pEnd <> Nil then
           begin
            SetString( foundText,
            Pchar(S) + (pScan- PChar(searchtext) ),
            pEnd - pScan );
            list.Add( foundText );
            pScan := pEnd + Length(tag2);
           end
       else
      pScan := Nil;
    end;
  Until pScan = Nil;
end;

procedure  TMyThread.Update ;
begin
 Form2.Memo1.Lines.AddStrings(FResultString);
end;

//....................................................
procedure TMyThread.Execute;
var IdHttp1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    CookieManager1: TIDCookieManager;
    
    s:string;
begin


 IdSSLIOHandlerSocketOpenSSL1:=TIdSSLIOHandlerSocketOpenSSL.Create;
 CookieManager1:=TIDCookieManager.Create;
 IdHttp1:=TIdHTTP.Create;
 IdHttp1.IOHandler:=IdSSLIOHandlerSocketOpenSSL1;
 IdHttp1.CookieManager:=CookieManager1;
 IdHttp1.HandleRedirects:=true;

 S:= IdHttp1.Get(URL);
 FResultString:=TStringList.Create;
 IsolateText(s,'<a class="b-serp-item__title-link" href="','" onmousedown="rc',FResultString);
 Synchronize(Update);
 IdHttp1.Free;
 CookieManager1.Free;

end;


//......................................................
procedure TForm2.Button1Click(Sender: TObject);
begin
 for I := 0 to ListBox1.Items.Count -1 do
   begin
   with TMyThread.Create(True) do
  begin
    URL := ListBox1.Items[i];
    FreeOnTerminate := True;
    Priority := TPNormal;
    Resume;
  end;

end;


end;
//...............................................................


end.

[Пепел Феникса]

ну а кто вам мешает создать 10 потоков и ждать пока он закончит, потом дать новое задание?

[Kix.IV]

Сообщение от Пепел Феникса

ну а кто вам мешает создать 10 потоков и ждать пока он закончит, потом дать новое задание?

Либо запускать каждый раз новый поток.