Прикрутить многопоточность в программу.

[admin22]

Помогите сделать программму многопоточной. Прочитал тонны мануалов, но все равно не доходит.
Безпотоковая версия работает хорошо, а то что получилось - вообще отказывается работать. Укажите что не так:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, sSkinManager, sPanel, StdCtrls, sGroupBox, sMemo,
  sEdit, sLabel, sCheckBox, sGauge, ComCtrls, sStatusBar, Mask, sMaskEdit,
  sCustomComboEdit, sTooledit, sButton, IdCookieManager, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdBaseComponent, IdAntiFreezeBase,
  IdAntiFreeze, acProgressBar, sComboEdit;

type
  TForm2 = class(TForm)
    sSkinManager1: TsSkinManager;
    sMemo1: TsMemo;
    sGroupBox3: TsGroupBox;
    sLabelFX1: TsLabelFX;
    sLabelFX2: TsLabelFX;
    sEdit1: TsEdit;
    sEdit2: TsEdit;
    sCheckBox1: TsCheckBox;
    sStatusBar1: TsStatusBar;
    OpenDialog1: TOpenDialog;
    sMemo2: TsMemo;
    sButton1: TsButton;
    sButton2: TsButton;
    sButton4: TsButton;
    IdAntiFreeze1: TIdAntiFreeze;
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    sLabelFX9: TsLabelFX;
    sGroupBox5: TsGroupBox;
    sLabelFX3: TsLabelFX;
    sLabelFX4: TsLabelFX;
    sLabelFX5: TsLabelFX;
    sButton3: TsButton;
    sLabelFX6: TsLabelFX;
    sLabelFX7: TsLabelFX;
    sLabelFX8: TsLabelFX;
    sLabelFX10: TsLabelFX;
    sLabelFX11: TsLabelFX;
    sLabelFX12: TsLabelFX;
    Edit1: TEdit;
    UpDown1: TUpDown;

    procedure sButton4Click(Sender: TObject);

    procedure sButton1Click(Sender: TObject);
    procedure sMemo1Change(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
//Здесь необходимо описать класс TMyThread:
  TMyThread = class(TThread)
    private
    { Private declarations }
    i,l,good,bad,now:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;
  protected
  procedure update;
    procedure Execute; override;
  end;


var
  Form2: TForm2;
  //Нужно ввести переменную класса TMyThread
  MyThread: TMyThread;
  i,l,good,bad,now:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;


implementation

{$R *.dfm}

procedure TForm2.sButton1Click(Sender: TObject);
var
    i,l,good,bad:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;

begin
for l := 0 to updown1.position do
//Вначале нужно создать экземпляр потока:
  MyThread:=TMyThread.Create(true);
//Параметр False запускает поток сразу после создания, True - запуск впоследствии , методом Resume
//Далее можно указать параметры потока, например приоритет:
  MyThread.Priority:=tpNormal;
//Можно указать что после завершения кода поток завершится автоматически:
  MyThread.FreeOnTerminate:=false;
 MyThread.resume; 
end;

procedure TMyThread.Execute;
var
 i,l,good,bad:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;
begin
  inherited;
  form2.idHTTP1:=TIdHTTP.Create(nil);
form2.idhttp1.AllowCookies := true;
form2.idhttp1.HandleRedirects := true;
form2.idhttp1.Request.Host:=('*****.mail.ru');
form2.idhttp1.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:16.0) Gecko/20100101 Firefox/16.0';
form2.Idhttp1.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
form2.Idhttp1.Request.AcceptLanguage:='ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
form2.Idhttp1.Request.AcceptEncoding:='gzip, deflate';
form2.idhttp1.Request.Connection:='keep-alive';
form2.idhttp1.Request.ContentType:='application/x-www-form-urlencoded';
while i <> form2.smemo1.Lines.Count do begin
data:=TStringList.Create;
data.Clear;
email:='';
pass:='';
email:=trim(copy(form2.smemo1.Lines[i],1,pos(';',form2.smemo1.Lines[i])-1));
pass:=trim(copy(form2.smemo1.Lines[i],pos(';',form2.smemo1.Lines[i])+1,length(form2.smemo1.Lines[i])-pos(';',form2.smemo1.Lines[i])+1));
data.add('name='+email);
data.add('pass='+pass);
data.add('op=%D0%92%D1%85%D0%BE%D0%B4+%D0%B2+%D1%81%D0%B8%D1%81%D1%82%D0%B5%D0%BC%D1%83');
data.add('form_build_id=form-6d1652dd1259cd84e60af5e57ee4f61f');
data.add('form_id=user_login' );
s1:=form2.idhttp1.post ('сайт',data);
Synchronize(Update);
end;
end;

procedure TMyThread.update;
var s1,s2:string;
i:integer;
begin
  if pos ('Время участия',s1)>0 then  begin
form2.smemo2.lines.add (form2.smemo1.lines[i]);
end;
end;
end.

Надеюсь на вашу помощь)

[eoln]

Безпотоковая версия работает хорошо

Значит ничего не трогай

1)Убери форму у idhttp1 из потока

{form2.}idHTTP1:=TIdHTTP.Create(nil);
{form2.}idhttp1.AllowCookies := true;
...

и т.д.

2)Убери компонент IdHTTP1 с формы, т.к. он будет теперь динамический, а вот в класс потока внеси его объявление

  TMyThread = class(TThread)
    private
    { Private declarations }
    IdHTTP1: TIdHTTP;
    ...

3)Строчку

while i <> form2.smemo1.Lines.Count do begin

и другие обращения к мемо1 надо синхронизировать с главным потоком (самой программой). Кстати, где переменная i меняется в цикле?

4)Зачем многопоточность? Для скорости? Возможен обратный эффект. Пост запрос скорее всего маленький и пролетит быстро, а создание динамического idhttp и синхронизация всё затормозит. Если посты большие то тогда вполне оправдано. Я бы сделал в этом случае 1 поток, который считывает по несколько строк с мемо и запускает несколько потоков для скачивания. При завершении одного потока запускаем следующий и т.д.

[admin22]

Спасибо большое что откликнулись eoln

Да, для скорости, вдруг в мемо будет не 10-20 а допустим 500 и более строк, а у пользователя интернет быстрый)

Я бы сделал в этом случае 1 поток, который считывает по несколько строк с мемо и запускает несколько потоков для скачивания. При завершении одного потока запускаем следующий и т.д.

Будет наглостью с моей стороны просить готовый код)) Но я все - таки начинающий, не могли бы вы показать, как это будет выглядеть

[Человек_Борща]

eoln, не имеет значения сколько строк берет поток, имеет значение только то, что поток всего 1.

Делите кол-во строк на желаемое кол-во потоков, остаток отдайте последнему потоку. Итого, скорость подпрыгнет в разы.
admin22, в папке Demos, в каталоге Delphi, есть пример с потоками. Так же по форуму

просить готовый код))

уже не мало раз было. ищите поиском.

[admin22]

Проблема по прежнему актуальна. Не могу понять, почему не работает. Вроде бы все советы eoln'a выполнил:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, sSkinManager, sPanel, StdCtrls, sGroupBox, sMemo,
  sEdit, sLabel, sCheckBox, sGauge, ComCtrls, sStatusBar, Mask, sMaskEdit,
  sCustomComboEdit, sTooledit, sButton, IdCookieManager, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, IdBaseComponent, IdAntiFreezeBase,
  IdAntiFreeze, acProgressBar, sComboEdit;

type
  TForm2 = class(TForm)
    sSkinManager1: TsSkinManager;
    sMemo1: TsMemo;
    sGroupBox3: TsGroupBox;
    sLabelFX1: TsLabelFX;
    sLabelFX2: TsLabelFX;
    sEdit1: TsEdit;
    sEdit2: TsEdit;
    sCheckBox1: TsCheckBox;
    sStatusBar1: TsStatusBar;
    OpenDialog1: TOpenDialog;
    sMemo2: TsMemo;
    sButton1: TsButton;
    sButton2: TsButton;
    sButton4: TsButton;
    IdAntiFreeze1: TIdAntiFreeze;
    IdCookieManager1: TIdCookieManager;
    sLabelFX9: TsLabelFX;
    sGroupBox5: TsGroupBox;
    sLabelFX3: TsLabelFX;
    sLabelFX4: TsLabelFX;
    sLabelFX5: TsLabelFX;
    sButton3: TsButton;
    sLabelFX6: TsLabelFX;
    sLabelFX7: TsLabelFX;
    sLabelFX8: TsLabelFX;
    sLabelFX10: TsLabelFX;
    sLabelFX11: TsLabelFX;
    sLabelFX12: TsLabelFX;
    Edit1: TEdit;
    UpDown1: TUpDown;
procedure sButton4Click(Sender: TObject);
procedure sButton1Click(Sender: TObject);
procedure sMemo1Change(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;





 //Здесь необходимо описать класс TMyThread:
  TMyThread = class(TThread)
    private
    { Private declarations }
    IdHTTP1: TIdHTTP;
    i,l,good,bad,now:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;
  protected
  procedure update;
    procedure Execute; override;
  end;




var
  Form2: TForm2;
  //Нужно ввести переменную класса TMyThread
  MyThread: TMyThread;
  i,l,good,bad,now:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;


implementation

{$R *.dfm}

procedure TForm2.sButton1Click(Sender: TObject);
var
    i,l,good,bad:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;

begin
for l := 0 to updown1.position do
//Вначале нужно создать экземпляр потока:
  MyThread:=TMyThread.Create(False);
//Параметр False запускает поток сразу после создания, True - запуск впоследствии , методом Resume
//Далее можно указать параметры потока, например приоритет:
  MyThread.Priority:=tpNormal;
//Можно указать что после завершения кода поток завершится автоматически:
  MyThread.FreeOnTerminate:=false;
end;


procedure TMyThread.Execute;
var
 i,l,good,bad:Integer;
    email,pass,s1,s2:string;
  Data:tStringlist;
begin
  inherited;
idHTTP1:=TIdHTTP.Create(nil);
idhttp1.AllowCookies := true;
idhttp1.HandleRedirects := true;
idhttp1.Request.Host:=('');
idhttp1.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:16.0) Gecko/20100101 Firefox/16.0';
Idhttp1.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
Idhttp1.Request.AcceptLanguage:='ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
Idhttp1.Request.AcceptEncoding:='gzip, deflate';
idhttp1.Request.Connection:='keep-alive';
idhttp1.Request.Referer:='' ;
idhttp1.Request.ContentType:='application/x-www-form-urlencoded';
while i <> form2.smemo1.Lines.Count do begin
inc (i);
data:=TStringList.Create;
data.Clear;
email:='';
pass:='';
email:=trim(copy(form2.smemo1.Lines[i],1,pos(';',form2.smemo1.Lines[i])-1));
pass:=trim(copy(form2.smemo1.Lines[i],pos(';',form2.smemo1.Lines[i])+1,length(form2.smemo1.Lines[i])-pos(';',form2.smemo1.Lines[i])+1));
data.add('name='+email);
data.add('pass='+pass);
data.add('op=%D0%92%D1%85%D0%BE%D0%B4+%D0%B2+%D1%81%D0%B8%D1%81%D1%82%D0%B5%D0%BC%D1%83');
data.add('form_build_id=form-6d1652dd1259cd84e60af5e57ee4f61f');
data.add('form_id=user_login' );
s1:=idhttp1.post ('*****',data);
Synchronize(Update);
end;
end;

procedure TMyThread.update;
var s1,s2:string;
i:integer;
begin
  if pos ('Время участия',s1)>0 then  begin
form2.smemo2.lines.add (form2.smemo1.lines[i]);
end;
end;
end.

[Perchik71]

А почему вы синхронизируете с методом потока?
//-----
ну а если быть честным.... чему равно i????
и попадаете ли вы?
//----
и не забывайте что нужно чистить..
data.Free;

[admin22]

А почему вы синхронизируете с методом потока?

По другому не умею. А как надо?

ну а если быть честным.... чему равно i????

и попадаете ли вы?

Куда попадаю?

и не забывайте что нужно чистить..
data.Free;

Не забываю )

[Perchik71]

Я очень люблю при отладке работать с Assert().
вы с потоко обращаетесь так как будто он функция.
выделение и уничтожение idhttp должно происходить в конструкторе и диструкторе... В вашем коде не вижу что вы как то управляете над памятью. В потоке желательно вобще использовать минимум vcl ибо она однопоточная. Она конечно позволяет рисовать на канве, но чтото я вижу все рисуют через device context а не канвой. освободите поток от выделений памяти.. установите ассерты и наблюдайте за кодом.. ассерт сработает и укажит даже где.
//----
А так же используйте цикл for для явных циклов... где вы знаете начало и конец.

[admin22]

Сообщение от Perchik71

вы с потоко обращаетесь так как будто он функция.

Я с потоками плохо знаком, поэтому и интересуюсь, как надо

[Perchik71]

Сообщение от eoln

4)Зачем многопоточность? Для скорости? Возможен обратный эффект. Пост запрос скорее всего маленький и пролетит быстро, а создание динамического idhttp и синхронизация всё затормозит. Если посты большие то тогда вполне оправдано. Я бы сделал в этом случае 1 поток, который считывает по несколько строк с мемо и запускает несколько потоков для скачивания. При завершении одного потока запускаем следующий и т.д.

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