как Задать количество потоков в классе TPotok

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, IdThreadComponent;

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;
Button6: TButton;
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);
procedure Button6Click(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;
Label1.Caption:= '0';
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.Button6Click(Sender: TObject);
begin
sMemo1.clear;
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:=0 to 100 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.

RPI.su - самая большая русскоязычная база вопросов и ответов. Наш проект был реализован как продолжение популярного сервиса otvety.google.ru, который был закрыт и удален 30 апреля 2015 года. Мы решили воскресить полезный сервис Ответы Гугл, чтобы любой человек смог публично узнать ответ на свой вопрос у интернет сообщества.

Все вопросы, добавленные на сайт ответов Google, мы скопировали и сохранили здесь. Имена старых пользователей также отображены в том виде, в котором они существовали ранее. Только нужно заново пройти регистрацию, чтобы иметь возможность задавать вопросы, или отвечать другим.

Чтобы связаться с нами по любому вопросу О САЙТЕ (реклама, сотрудничество, отзыв о сервисе), пишите на почту [email protected]. Только все общие вопросы размещайте на сайте, на них ответ по почте не предоставляется.