VPF::Некоректно работает многопоточность

UKRtortik

Дата 8.6.2014, 22:08 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 29
Регистрация: 24.3.2014

Репутация: нет
Всего: нет

А почему Work должен быть именно локальной переменной в Execute?

Добавлено через 3 минуты и 34 секунды
Переписал код, вроде сейчас все нормально работает. Есть какие то замечания по коду?

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RegExpr,
  StdCtrls, ComCtrls, Gauges, SyncObjs, Spin, Buttons, ExtCtrls, XPMan, HTTPSend;

type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    Panel5: TPanel;
    SpinEdit1: TSpinEdit;
    SpeedButton2: TSpeedButton;
    SpeedButton1: TSpeedButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

 TNewThread = class(TThread)
  private
  Test  : Integer;
  proxys: string;
  protected
    procedure Execute; override;
  public
  procedure Sync;
  procedure Sync2;
  procedure bads;
  procedure ends;
  constructor Create(CreateSuspended: Boolean);

  end;

var
  Form1: TForm1;
  Proxy:Tstringlist;
  Thread, Acc:integer;
  Work:boolean;
  CS:TcriticalSection;
  Potok: TNewThread;
  r : TRegExpr;
  html, pr: Tstringlist;
  HTTP: THTTPSend;
  ipmaska:string;

implementation

{$R *.dfm}


constructor TNewThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
end;

procedure TNewThread.Execute;
var Num:integer;
begin
 while Work do
  begin
   CS.Enter;
   Inc(Acc);
   if Acc<proxy.Count then Num:=Acc else Work:=false;
   CS.Leave;
   if Work then
    begin
     HTTP:=THTTPSend.create();
     r:=TRegExpr.Create;
     HTTP.UserAgent:='Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/33.0.1750.154 Safari/537.36 OPR/20.0.1387.82';
     ipmaska:='\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{2,6}';
     r.Expression := ipmaska;
     //try
     html:=TStringList.Create;
     HTTP.HTTPMethod('HEAD', proxy.Strings[Num]);
     if http.ResultCode=200 then
     begin
     HTTP.HTTPMethod('GET', proxy.Strings[Num]);
     html.LoadFromStream(http.Document);
     if http.ResultCode=200 then
     begin
     if r.Exec(html.text) then
     REPEAT
     if Work=True then
     begin
     proxys:=r.Match[0];
     sleep(2);
     Synchronize(Sync);
     end;
     UNTIL not r.ExecNext; Synchronize(Sync2);
     end else Synchronize(bads);
     end else Synchronize(bads);
     end;
// if Thread=0 then
if num=form1.ProgressBar1.Position then
 begin
 Synchronize(ends);
 end;
 dec(Thread);
end;
end;

procedure TNewThread.Sync;
var
i:integer;
begin
pr.Add(proxys);
form1.Label1.Caption:=inttostr(pr.count);
end;

procedure TNewThread.Sync2;
begin
form1.Memo2.Text:=pr.Text;
form1.ProgressBar1.Position:=form1.ProgressBar1.Position+1;
form1.Label6.Caption:=inttostr(form1.ProgressBar1.Position);
end;


procedure TNewThread.bads;
begin
form1.ProgressBar1.Position:=form1.ProgressBar1.Position+1;
form1.Label6.Caption:=inttostr(form1.ProgressBar1.Position);
end;

procedure TNewThread.ends;
begin
form1.Memo2.Lines.Add('End!!!');
form1.Memo2.Refresh;
 HTTP.Free;
 html.free;
 r.Free;
 form1.SpeedButton1.Enabled:=true;
 form1.SpeedButton2.Enabled:=false;
end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Proxy.Free;
 CS.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Proxy:=Tstringlist.create;
 CS:=TcriticalSection.create;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if SpinEdit1.Value>memo1.Lines.Count then
ShowMessage('Потоков больше чем ссылок быть не может!')
else
begin
 SpeedButton1.Enabled:=false;
 SpeedButton2.Enabled:=true;
 Acc:=-1;
 Work:=true;
 proxy.text:=memo1.Text;
 ProgressBar1.Position:=0;
 memo2.Clear;
 label6.Caption:='0';
 label1.Caption:='0';
 ProgressBar1.Max:=memo1.Lines.Count;
 for Thread:=0  to strtoint(SpinEdit1.Text) do
 pr:=TStringList.Create;
 Potok:=TNewThread.Create(false);
 Thread:=strtoint(SpinEdit1.Text);
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
 if work=True then
  //if assigned(Potok) then
  begin
  If not (Potok = nil) then Potok.Suspended:=not Potok.Suspended;
  end;
 SpeedButton1.Enabled:=true;
 SpeedButton2.Enabled:=false;
 Work:=false;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
Label3.Caption:=inttostr(memo1.Lines.Count);
end;

end.

Illusion Dolphin

Дата 9.6.2014, 09:46 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63

Цитата

Есть какие то замечания по коду?

Нет, никаких замечаний, всё просто прекрасно smile

. Вы только ни в коем случае не читайте наши предыдущие ответы, они все написаны из вредности чтобы сломать этот превосходный код. Также не следуйте никаким советам, что даются отпытными людьми на форуме, хотя тут вы и без этого моего ответа отлично справляетесь! Дерзайте, и вас ждёт светлое будущее!

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

UKRtortik

Дата 9.6.2014, 10:14 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 29
Регистрация: 24.3.2014

Репутация: нет
Всего: нет

Я просто не понял как сделать Work:boolean был локальной переменной, у меня перестает код работать.

PointerToNil

Дата 9.6.2014, 15:04 (ссылка)

(нет голосов)

Загрузка ...

Профиль
Группа: Участник
Сообщений: 108
Регистрация: 17.6.2013

Репутация: 3
Всего: 6

Была гипотеза, что строчкой "Work := Num < proxy.Count" тред, взявший на обработку последнюю строку, менял глобальную переменную Work, из-за чего ВСЕ ранее запустившиеся треды разом переставали работать, отваливаясь на проверках "while Work do" и "if Work then".

Если она менялась еще и извне (я это упустил) - то, очевидно, нужны 2 переменных - глобальная для "сигнализации" и локальная для условия окончания работы данного треда.

> у меня перестает код работать
пожалуйста, не пишите больше так! обычно что-то конкретное происходит не так, появляются симптомы, которые можно описать
(это не к данному вопросу, тут вроде понятно, но вообще - старайтесь давать как можно больше деталей в своих описаниях)

P.S. последнюю версию кода не читал. я уже устал.
Работает - отлично, ничего не трогаем.
Гипотеза не подтвердилась? Проверили, вернули всё назад, ищем дальше.

Это сообщение отредактировал(а) PointerToNil - 9.6.2014, 15:09

UKRtortik

Дата 9.6.2014, 15:12 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 29
Регистрация: 24.3.2014

Репутация: нет
Всего: нет

Так что код сейчас правильный или нет?

PointerToNil

Дата 9.6.2014, 15:34 (ссылка)

(нет голосов)

Загрузка ...

Профиль
Группа: Участник
Сообщений: 108
Регистрация: 17.6.2013

Репутация: 3
Всего: 6

а что, по работе непонятно?
как бы самому выступить в роли компьютера и весь его исполнить в уме, конечно, можно, только комп-то это быстрее сделает

Добавлено через 2 минуты и 22 секунды
если в чем-то сомневаетесь - воспользуйтесь средствами отладки (точки останова, просмотр значений переменных, пошаговый прогон) либо выводом отладочных сообщений

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

Добавлено через 5 минут и 34 секунды
и уж тем более через форум отлаживать прогу - худшая из идей

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »