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.

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

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

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

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

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

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: Общие вопросы \| Следующая тема »