Много-поточность

[Kirilis2018]

Сделал Proxy Парсер по ссылкам и что бы форма не зависала переместил в отдельный поток.

Мужики, знатоки в потоках помогите решить задачу: Как сделать что бы программа работала в 50 потоков.

И предполагаю что это что то типа (В моем случае):

for i:=0 to 50 do
 begin
    TPotok.Create(true);
 end;

Вот готовый одно-поточный вариант (Очень надеюсь на вашу помощь, Уважаемые программисты!):

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdHTTP, Buttons, RegExpr, sMemo, sSkinProvider,
  sSkinManager, acPNG, ExtCtrls, jpeg, sButton, sLabel, IdBaseComponent,
  IdAntiFreezeBase, IdAntiFreeze;
 
type
  TForm1 = class(TForm)
    SaveDialog1: TSaveDialog;
    sSkinManager1: TsSkinManager;
    sSkinProvider1: TsSkinProvider;
    sMemo1: TsMemo;
    sMemo2: TsMemo;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    sButton1: TsButton;
    IdAntiFreeze1: TIdAntiFreeze;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Label2: TLabel;
    procedure Image4Click(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure sMemo2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  // Поток
type
  TPotok = class(TThread)
  private
    html: WideString;
    procedure reg;
  protected
    procedure Execute; override;
  end;
 
var
  Form1: TForm1;
  Potok: TPotok;
  HTTP: TIdHTTP;
  site, html, s: string;
  rege: tregexpr;
  i: integer;
 
implementation
 
uses Unit2;
 
{$R *.dfm}
 
procedure TPotok.reg;
begin
  Form1.sMemo2.Lines.Add(rege.Match[0]);
end;
 
procedure TPotok.Execute;
begin
  for i := 0 to Form1.sMemo1.Lines.Count - 1 do
  begin
    try
      site := Form1.sMemo1.Lines.Strings[i];
      html := HTTP.Get(site);
    except
    end;
    if rege.Exec(html) then
      repeat
        Synchronize(reg);
      until (not rege.ExecNext) or Potok.Terminated;
    if Potok.Terminated then
      break;
  end;
  HTTP.Free;
  rege.Free;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  sMemo2.clear;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    sMemo2.Lines.SaveToFile(SaveDialog1.FileName);
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  if not Assigned(Potok) then
    ShowMessage('Программа не запущена')
  else
  begin
    Potok.Terminate;
  end;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
begin
  HTTP := TIdHTTP.Create(nil); // экземпляр tidhttp
  rege := tregexpr.Create;
  rege.Expression := '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{1,5}';
 
  Potok := TPotok.Create(true); // т.к запускаем через Resume
  Potok.Priority := tpLower;
  Potok.FreeOnTerminate := true;
  Potok.Resume;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
begin
  Potok.suspend;
end;
 
procedure TForm1.Image4Click(Sender: TObject);
begin
  sMemo2.clear;
end;
 
procedure TForm1.sButton1Click(Sender: TObject);
var
  i, j: integer;
begin
  for i := sMemo2.Lines.Count - 1 downto 0 do
    for j := i - 1 downto 0 do
      if sMemo2.Lines[i] = sMemo2.Lines[j] then
        sMemo2.Lines.Delete(i);
end;
 
procedure TForm1.sMemo2Change(Sender: TObject);
begin
  Label1.Caption := IntToStr(sMemo2.Lines.Count);
end;
 
end.

[^D^ima]

Цитата Kirilis2018 @ 07.03.19, 09:09

for i := 0 to Form1.sMemo1.Lines.Count - 1 do

А как ты хочешь это расспаралелить?

[Kirilis2018]

^D^ima,я тут даже не знаю как правильней это сделать ? Я так понял тут нужно что бы они синхронно работали ?

[^D^ima]

Я в потоках не силен, но ты уверен что это даст сильный прирост скорости?

[Kirilis2018]

^D^ima, А такой вариант реален: один тред = одному URL ?

Добавлено 07.03.19, 09:56
^D^ima, В любом случае сбор адресов будет быстрее. Я видел как у других разработчиков в раз 10 быстрее работает в 5 потоков нежели в один.

[vasya2019]

как в первом посте написали код через цикл так и запускайте, только в каждый поток передавайте юрл ссылку из списка, ну и синхронизация через критические секции.

[Kirilis2018]

vasya2019, Помогите сделать в потоках я не силен!

[vasya2019]

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

function ThreadFunc(Info: Pointer): Integer; stdcall;
var
  i: Integer;
  HTTP: TIdHTTP;
  html: WideString;
begin
  HTTP := TIdHTTP.Create(nil);
  html := HTTP.Get(Info);
  rege.Exec(html)
  if rege.Exec(html) then
    repeat
      EnterCriticalSection(CriticalSection);
      Form1.sMemo2.Lines.Add(rege.Match[0]);
      LeaveCriticalSection(CriticalSection);
    until (not rege.ExecNext);
  HTTP.Free;
  ExitThread(4);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  TID: Cardinal;
begin
  InitializeCriticalSection(CriticalSection);
    for i := 0 to sMemo2.Lines.Count - 1 do CreateThread(nil, 0, @ThreadFunc, @sMemo2.Lines[i], 0, TID);
end;

[Kirilis2018]

vasya2019, Увы но так не срабатывает.

[vasya2019]

что именно не срабатывает?

[Kirilis2018]

vasya2019, Вот тут идут ошибки при компиляции:

EnterCriticalSection(CriticalSection);
Form1.sMemo2.Lines.Add(rege.Match[0]);
LeaveCriticalSection(CriticalSection);

[vasya2019]

ошибки, что CriticalSection не объявлен?

var
CriticalSection: TRTLCriticalSection;

[Kirilis2018]

vasya2019, Да, сейчас еще сижу и разбираюсь. После отпишу. Заранее спасибо за помощь.

[Cfon]

Уже давно все юзают PPL
http://www.proghouse.ru/programming/36-delphi-xe7-ppl

[Kirilis2018]

vasya2019,Cfon, В общем завис я на этом вопросе. Сегодня пол ночи просидел и результат просто НОЛЬ . Кто поможет, в долгу не останусь!