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

UKRtortik

Дата 15.5.2014, 14:04 (ссылка)

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

Загрузка ...

Новичок

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

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

Все Добрый День!

Код


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;
   form1.Memo2.Enabled:=false;
   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{1,5}';
     r.Expression := ipmaska;
     try
     html:=TStringList.Create;
     if HTTP.HTTPMethod('GET', proxy.Strings[Num]) then
     begin
     html.LoadFromStream(http.Document);
     r.Expression := ipmaska;
     end;
     finally
     if http.ResultCode=200 then
     begin
     if r.Exec(html.text) then
     REPEAT
     if Work=True then
     begin
     proxys:=r.Match[0];
     sleep(5);
     Synchronize(Sync);
     end;
     UNTIL not r.ExecNext; Synchronize(Sync2);
     end;
     end;
  end;
  end;
 if Thread=0 then
 begin
 HTTP.Free;
 html.free;
 r.Free;
 form1.SpeedButton1.Enabled:=true;
 form1.SpeedButton2.Enabled:=false;
 form1.Memo2.Enabled:=true;
 form1.Memo2.Lines.Add('Успешно завершено!');
 end;
 dec(Thread);
end;

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

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

Почему то обрабатывает не все ссылки, и если поставить например 20 потоков то вообще начинает пропускать половина ссылок. В чем тут может быть проблема?

Poseidon

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

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

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

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

Acc - это что? Глобальная переменная? Еще к ней кто-то имеет доступ на изменение?

PS. А в чем вообще смысл метода TNewThread.Create?

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

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

Illusion Dolphin

Дата 15.5.2014, 16:45 (ссылка)

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

Загрузка ...

Эксперт

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

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

Код


form1.Memo2.Enabled:=false;

Нельзя обращаться к элементам формы напрямую

2)

Код


HTTP:=THTTPSend.create();

Не нужно использовать общие переменные в этом месте

3) Парные вещи делают через

Код


   CS.Enter;
   try
   ...
   finally
     CS.Leave;
   end;

4)
Нужно форматировать код

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

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

PointerToNil

Дата 16.5.2014, 10:00 (ссылка)

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

Загрузка ...

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

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

UKRtortik, ну почему ты весь код сразу не показываешь? воображать и гадать приходится...
вот как у тебя критическая секция инициализируется??? (есть догадки, что неправильно)
может, у тебя у каждого потока своя CS - вот было бы круто: "я в свою критическую секцию вошел, а ваши меня ниипут"

PointerToNil

Дата 16.5.2014, 11:41 (ссылка)

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

Загрузка ...

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

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

кстати,

Код


   CS.Enter;
   Inc(Acc);
   if Acc<proxy.Count then Num:=Acc else Work:=false;
   CS.Leave;

можно заменить на

Код


   Num := InterlockedIncrement(Acc);
   Work := Num < proxy.Count;

я бы попробовал

UKRtortik

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

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

Загрузка ...

Новичок

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

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

Цитата(PointerToNil @ 16.5.2014, 10:00)

Вот полный код:

Код


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;
    constructor Create(CreateSuspended: Boolean);
  end;

var
  Form1: TForm1;
  Proxy:Tstringlist;
  Thread, Acc:integer;
  Work:boolean;
  CS:TcriticalSection;
  Potok: TNewThread;
  r : TRegExpr;
  html: 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
   Num := InterlockedIncrement(Acc);
   Work := Num < proxy.Count;
   form1.Memo2.Enabled:=false;
   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{1,5}';
     r.Expression := ipmaska;
     try
     html:=TStringList.Create;
     if HTTP.HTTPMethod('GET', proxy.Strings[Num]) then
     begin
     html.LoadFromStream(http.Document);
     r.Expression := ipmaska;
     end;
     finally
     if http.ResultCode=200 then
     begin
     if r.Exec(html.text) then
     REPEAT
     if Work=True then
     begin
     proxys:=r.Match[0];
     sleep(5);
     Synchronize(Sync);
     end;
     UNTIL not r.ExecNext; Synchronize(Sync2);
     end;
     end;
  end;
  end;
 if Thread=0 then
 begin
 HTTP.Free;
 html.free;
 r.Free;
 form1.SpeedButton1.Enabled:=true;
 form1.SpeedButton2.Enabled:=false;
 form1.Memo2.Enabled:=true;
 form1.Memo2.Lines.Add('Успешно завершено!');
 end;
 dec(Thread);
end;

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

procedure TNewThread.Sync2;
begin
form1.ProgressBar1.Position:=form1.ProgressBar1.Position+1;
form1.Label6.Caption:=inttostr(form1.ProgressBar1.Position);
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
 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.

PointerToNil

Дата 16.5.2014, 12:52 (ссылка)

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

Загрузка ...

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

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

var Work:boolean должен быть локальнойпеременной в procedure TNewThread.Execute

и на всякий случай:
1) InterlockedDecrement(Thread) вместо dec(Thread)
2) Potok[Thread]:=TNewThread.Create(false); (или что там у тебя должно быть в Potok? там останется только последний из)

Illusion Dolphin

Дата 16.5.2014, 19:32 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата

var
...
HTTP: THTTPSend;

Это общий ресурс, а вы в каждом потоке его используете. Это должен быть локальные объект в потоке.

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

UKRtortik

Дата 17.5.2014, 21:20 (ссылка)

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

Загрузка ...

Новичок

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

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

Переписал код. Соровно не коректо не много работает:

Код


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;
    Label7: TLabel;
    bad: 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;
    HTTP: THTTPSend;
  protected
    procedure Execute; override;
  public
    procedure Sync;
    procedure Sync2;
    procedure Sync3;
    constructor Create(CreateSuspended: Boolean);
  end;

var
  Form1: TForm1;
  Proxy: Tstringlist;
  Thread, Acc: Integer;
  Work: Boolean;
  CS: TcriticalSection;
  Potok: TNewThread;
  r: TRegExpr;
  html: Tstringlist;
  ipmaska: string;

implementation

{$R *.dfm}

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

procedure TNewThread.Execute;
var
  Num, i: Integer;
begin
  while Work do
  begin
    Num := InterlockedIncrement(Acc);
    Work := Num < Proxy.Count;
    Form1.Memo2.Enabled := false;
    if Work then
    begin
      HTTP := THTTPSend.Create();
      r := TRegExpr.Create;
      html := Tstringlist.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{1,6}';
      r.Expression := ipmaska;
      //начало цыкла
      for i := 0 to 2 do
        begin
          try
            HTTP.HTTPMethod('GET', Proxy.Strings[Num])
          except
          end;
          if HTTP.ResultCode = 200 then
            break;
        end;
      //конец цыкла
        /// начало проверки
        if HTTP.ResultCode = 200 then
        begin
        html.LoadFromStream(HTTP.Document);
        r.Exec(html.text);
        if r.Match[0]='' then
        form1.bad.caption:=inttostr(strtoint(form1.bad.caption)+1)
        else
        begin
          Synchronize(Sync2);

          if not r.Exec(html.text) then
          exit;
            REPEAT
                proxys := r.Match[0];
                sleep(5);
                Synchronize(Sync);
            until not r.ExecNext;
          end;
        end else
        begin
        form1.bad.caption:=inttostr(strtoint(form1.bad.caption)+1);
        form1.ProgressBar1.Position:=form1.ProgressBar1.Position+1;
        end;
        //конец проверки
  end;
  end;
  InterlockedDecrement(Thread);
  if Proxy.Count=Num then
  Thread:=0;
  if Thread = 0 then
  begin
  if Potok.Terminated then
    Synchronize(Sync3);
    HTTP.Free;
    html.Free;
    r.Free;
end;
end;

procedure TNewThread.Sync;
var
  i: Integer;
begin
  Form1.Memo2.Lines.Add(proxys);
  Form1.Label1.Caption := inttostr(Form1.Memo2.Lines.Count);
end;

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

procedure TNewThread.Sync3;
begin
Form1.ProgressBar1.Max:=Form1.ProgressBar1.Max-strtoint(form1.bad.caption);
    Form1.SpeedButton1.Enabled := True;
    Form1.SpeedButton2.Enabled := false;
    Form1.Memo2.Enabled := True;
    Form1.Memo2.Lines.Add('Успешно завершено!');
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
      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.

У кого еще какие предложения будут?

b8195108

Дата 17.5.2014, 22:24 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(UKRtortik @ 17.5.2014, 21:20

)

У кого еще какие предложения будут?

Купить и почитать 2 книги:
1. Русский язык.
2. Delphi для начинающих.

UKRtortik

Дата 17.5.2014, 22:42 (ссылка)

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

Загрузка ...

Новичок

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

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

что не так?

Illusion Dolphin

Дата 18.5.2014, 10:31 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата

что не так?

1) Общие ресурсы r, html
2) Нельзя обращаться к элементам формы напрямую
3) Оформлеие кода

Цитата

Соровно не коректо не много работает:

Ашыпка навена дета smile

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

PointerToNil

Дата 18.5.2014, 12:40 (ссылка)

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

Загрузка ...

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

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

UKRtortik, указания игнорируете и ждете других? непонятно, на что надеетесь
Work должен быть локальной переменной в Execute - непонятно написал?
в других местах замените "if Work = True" на "if Acc < Proxy.Count"

UKRtortik> что не так?

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

P.S. зачем по SpeedButton2 ставить на паузу один поток (последний из созданных) - для меня загадка

P.S.2 навставляйте во все ключевые места Execute вывод в ваше мемо строк с текстом о текущей стадии процесса со значениями ключевых переменных (ThreadId, Num, ...) - это называется debug log

(чтобы не изобретать передачу параметра через synchronize и не загромождать ваше Memo лишним,
можно выводить лог винапишным OutputDebugMessage и просматривать через View | Debug Windows | Event Log (или утилитку DebugView от sysinternals)
или добавить в любой модуль {$APPTYPE CONSOLE} и выводить лог в окно консоли простыми WriteLn'ами

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

UKRtortik

Дата 29.5.2014, 13:46 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата

Work должен быть локальной переменной в Execute

А как тогда останавливать поток буду?

Poseidon

Дата 29.5.2014, 14:45 (ссылка)

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

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

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

Цитата(UKRtortik @ 29.5.2014, 13:46

)

А как тогда останавливать поток буду?

Через переменную потока. В твоем случае эта переменная будет типа TNewThread.

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

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

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