VPF::Потоки? Как? - Форум программистов

arashvg

Дата 4.2.2012, 17:02 (ссылка)

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

Загрузка ...

Новичок

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

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

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

Собственно у меня есть список сайтов, есть процедура, которая делает гет запрос парсит, то что мне нужно, записывает в переменную. Собственно как это сделать с помощью потоков? ниже приведен полный листинг примера, то что прога делает теперь, повторяюсь, это только пример.

Зарание спасибо!

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure pars(s1,s2,s3,s4,s5:string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
sp1=record
title:string[150];
purl:string[200];
end;

var
  Form1: TForm1;
i,n,t:integer;
title,rss,html,title1,title2:WideString;
mas,mas1,mas2,mas3:array[1..50]of sp1;
implementation

{$R *.dfm}
procedure TForm1.pars(s1,s2,s3,s4,s5:string);
var
i,n:integer;
begin
rss:=IdHTTP1.Get(s1);
   n:=1;
   i:=1;
   title:='';
   while (i<=length(rss)) do
    begin
     if pos(s2,rss)<>0 then
      begin
      Delete(rss,1,pos(s2,rss)+length(s2)-1);
       title:=copy(rss,1,pos(s3,rss)-1);
       memo1.lines.add(title);
       mas[n].title:=title;

       Delete(rss,1,pos(s4,rss)+length(s4)-1);
       title:=copy(rss,1,pos(s5,rss)-1);
       memo1.lines.add(title);
       mas[n].purl:=title;

       n:=n+1;
       Application.ProcessMessages();
      end else break;

      end;

     inc(i);
Application.ProcessMessages();

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
pars('http://filmix.net/',''' title=''','''  /></a>','<a href="','">смотреть онлайн »');
mas1:=mas;

pars('http://bigcinema.tv/','</span></li></ul></div><div class="topic_info"><h2 class="title">','</h2>','<!-- / tag groups--><a href="','" class="watch" title="');
mas2:=mas;

end;

end.

Это сообщение отредактировал(а) arashvg - 4.2.2012, 17:02

Akella

Дата 5.2.2012, 00:33 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

Только вопрос забыл задать. Волнуешься?

Добавлено через 3 минуты и 53 секунды
Читал?
Работа с потоками в Delphi

ZBugz

Дата 5.2.2012, 08:44 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

Иль вот http://callipso.bestcode.org/delphi/artical/num2.html

arashvg

Дата 5.2.2012, 09:34 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(Akella @ 5.2.2012, 00:33

)

Только вопрос забыл задать. Волнуешься?

не забыл

Цитата(arashvg @ 4.2.2012, 17:02

)

Собственно как это сделать с помощью потоков?

Цитата(Akella @ 5.2.2012, 00:33

)

Читал?
Работа с потоками в Delphi

читал, нифига не понял, именно поэтому и спрашиваю. Хотелось бы увидеть или почитать что-то по-проще для начала smile

Цитата(ZBugz @ 5.2.2012, 08:44

)

Иль вот http://callipso.bestcode.org/delphi/artical/num2.html

спсибо, это больше подойдет, иду изучать!

Akella

Дата 5.2.2012, 15:07 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

arashvg, аа, ты хочешь, чтобы твой код тебе полностью переписали на потоки? Тогда тебе в другой раздел. Есть Центр помощи и фриланс.

Добавлено через 53 секунды

Цитата(arashvg @ 5.2.2012, 09:34

)

читал, нифига не понял,

значит читай, экспериментируй, изучай до полного просветления

Добавлено через 2 минуты и 14 секунд
Я так понимаю, что тебе pars(s1,s2,s3,s4,s5:string) нужно запихать в поток. Работай над этим.

MetalFan

Дата 7.2.2012, 07:29 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Цитата(ZBugz @ 5.2.2012, 08:44

)

Иль вот http://callipso.bestcode.org/delphi/artical/num2.html

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

Цитата

Код


var
  Section: TCriticalSection; // глобальная переменная
begin
  Section.Create;
end;

Цитата

Если AddStr вызовем методом Synchronize, то строчки добавятся сначала от одного потока, а затем от второго. Получается, что поток монопольно захватывает ресурс Memo и добавляет в него необходимую информацию, после добавления поток освобождает Memo и вот теперь уже другой поток может добавлять в Memo свои данные.

Бред какой-то....

Цитата

Код


procedure TNew.Execute;
var
  i: integer;
  n: integer;
begin
  for i := 1 to 10 do
  begin
    // Вход в критическую секцию
    CS.Enter;
    // Код, выполнение которого параллельно запрещено
    n := length(mas);
    [color=red]Form1.memo1.lines.add(IntToStr(mas[n-1]));[/color]
    sleep(5);
    SetLength(mas,n+1);
    mas[n] := mas[n-1]+1;
    // Выход из критической секции
    CS.Leave;
  end;
end;

Да, да, из доп.потока очень "полезно" обращаться к VCL компонентам... Может сразу на грабли обоими ногами вспрыгнуть?

Ну в общем приятных граблей новичкам после "изучения" этой статейки.
А автору пусть икается.

Это сообщение отредактировал(а) MetalFan - 7.2.2012, 07:39

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

There are always someone smarter than you...

MetalFan

Дата 7.2.2012, 08:07 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Кстати, презанятнешая класс-функция появилась у TThread в одной из последних версия делфи (XE?) CreateAnonymousThread.
Теперь легко и просто (конечно, с пониманием дела) можно "обернуть" выполнения участка кода в отдельный поток.

Краткий пример:

Код


function GetAndParse( const AUrl: string; var AResultStr: string ): Boolean;
var
  lThrd: TThread;
  lResStr: string;
  lRes: Boolean;
begin
  lThrd := TThread.CreateAnonymousThread( procedure
                                 begin
                                   with TIdHTTP.Create(nil) do
                                   try
                                     try
                                       lResStr := Get( AUrl );
                                       //разбор результата
                                       lRes := True;
                                     except
                                       lRes := False;
                                     end;
                                   finally
                                     Free;
                                   end;
                                 end );
  lThrd.Start;
  while not lThrd.Finished do
    Application.HandleMessage;
  Result := lRes;
  AResultStr := lResStr;
end;

procedure TForm1.btnClick(Sender: TObject);
var
  lRes: string;
begin
  TControl(Sender).Enabled := False;
  try
    if GetAndParse(Edt.text, lRes) then
      mem.Text := lRes
    else
      mem.Text := 'Something failed';
  finally
    TControl(Sender).Enabled := True;
  end;
end;

п.с. не претендую на чистоту кода. Если есть замечания по использованию анонимной функции - велкам...
п.п.с. подчеркну, что этот подход (вызов через CreateAnonymousThread подходит для простых случаев и ограничен в возможностях).

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

There are always someone smarter than you...

Gwire

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

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

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 216
Регистрация: 7.8.2007
Где: Николаев

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

Код


unit Unit1;

interface

uses Windows, Classes, Messages;

const
  Bell_EVENT = WM_USER + 1;

type
  sp1 = record
    title: String[150];
    purl: String[200];
  end;

  TMas = array[1..50]of sp1;

  { TParsThread }

  TParsThread = class(TThread)
  private
    FLines: TStringList;
    Ftitle, FRss, FHtml: WideString;
    FMas: TMas;
    S1, S2, S3, S4, S5: String;
    procedure pars;
  protected
    Process    : Boolean;
    BellTarget : HWND;
    Barrier    : THandle;
    procedure DoPars;
    procedure Execute; override;
  public
    constructor Create(BellTarget: HWND); reintroduce;
    destructor Destroy; override;
    function ExecuteFor(aS1, aS2, aS3, aS4, aS5: String): Boolean;
    property InProcess: Boolean read Process;
    property Lines: TStringList read FLines;
    property Title: WideString  read Ftitle;
    property RSS  : WideString  read FRss;
    property HTML : WideString  read FHtml;
    property Mas  : TMas        read FMas;
  end;

implementation

{ TParsThread }

procedure TParsThread.pars;
var i, n: Integer;
begin
    // твои расчеты
end;

procedure TParsThread.DoPars;
begin
    if Terminated then Exit;
    try
        Process:= True;
        pars;
    finally
        Process:= False;
    end;
    PostMessage( BellTarget, Bell_EVENT, Integer(Self), 0 );
end;

procedure TParsThread.Execute;
var A: Integer;
begin
    while not Terminated do
    begin
        A:= WaitForSingleObject( Barrier, INFINITE );
        case A of
          WAIT_OBJECT_0: DoPars;
          WAIT_ABANDONED: Terminate;
        end;
    end;
end;

constructor TParsThread.Create(BellTarget: HWND);
begin
    inherited Create(True);
    FLines:= TStringList.Create;
    Barrier:= CreateEvent(nil, False, False, nil);
    Self.BellTarget:= BellTarget;
    Process:= False;
    Resume;
end;

destructor TParsThread.Destroy;
begin
    Terminate;
    SetEvent( Barrier );
    CloseHandle( Barrier );

    FLines.Free;
    inherited;
end;

// Выполняестя из основного потока
function TParsThread.ExecuteFor(aS1, aS2, aS3, aS4, aS5: String): Boolean;
begin
    Result:= not InProcess;
    if Result then
    begin
        S1:= aS1;    S2:= aS2;    S3:= aS3;
        S4:= aS4;    S5:= aS5;
        SetEvent( Barrier );
    end;
end;

end.

Код


type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  public
    ParsTH1: TParsThread;
    procedure ParsThread_BellTarget(var M: TMessage); message Bell_EVENT;
  end;

var Form2: TForm2;

implementation {$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
    ParsTH1:= TParsThread.Create( Handle );
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
    ParsTH1.Free;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
    ParsTH1.ExecuteFor( 'http://filmix.net/',''' title=''','''  /></a>','<a href="','">смотреть онлайн »' );
end;

procedure TForm2.ParsThread_BellTarget(var M: TMessage);
begin
    if TParsThread(M.WParam) = ParsTH1 then
    begin
        // ParsTH1.Lines - Нереносишь сроки в свой Memo1
        // ParsTH1.Title
        // ParsTH1.RSS
        // ParsTH1.HTML
        // ParsTH1.Mas
    end;
end;

Это сообщение отредактировал(а) Gwire - 9.2.2012, 13:00

ZBugz

Дата 10.2.2012, 06:28 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

Цитата

Да, да, из доп.потока очень "полезно" обращаться к VCL компонентам... Может сразу на грабли обоими ногами вспрыгнуть?

MetalFan

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

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Gwire, очень спорный код... я бы написал по-другому. Но в целом, как пример, сойдет.

ZBugz, хм, а что не так?

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

There are always someone smarter than you...

Gwire

Дата 13.2.2012, 14:08 (ссылка)

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

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 216
Регистрация: 7.8.2007
Где: Николаев

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

Цитата(MetalFan @ 13.2.2012, 13:46

)

Gwire, очень спорный код... я бы написал по-другому.

Механизм выведен эмпирический способом.
При использовании нет AV, программа не зависает при завершении и простой вызов и доступ к результатам.
Поток не лезет к форме (к VCL). Основной поток ничего не может с ним сделать пока он в процессе вычислений (кроме прибить).
Недостатки? Не работает в полной мере без окна-получателя сообщений о завершении. Нужно проверять поле InProcess.

Gwire

Дата 13.2.2012, 14:38 (ссылка)

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

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 216
Регистрация: 7.8.2007
Где: Николаев

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

Цитата(MetalFan @ 13.2.2012, 13:46

)

ZBugz, хм, а что не так?

Когда то у меня были проблемы c потоками когда из них юзал VCL.
Вычитал что этого лучше не делать. Переделал. Проблемы исчезли.
Сейчас я понимаю, что нужно было синхронизировать доступ к компонентам VCL между основным и дополнительным потоками.
Но также понимаю что тогда пропадает нужда в дополнительном потоке. =/ Один останавливается чтобы подождать другого.

Конкретно в этой задаче, если дополнительный поток редко обращается к VCL, то ничего страшного в синхронизации с основным потоком нет.
Но так привыкнешь за собой тащить эти грабли, и когда то они тебе ударят по затылку. А ты будешь сидеть и думать: "Но ведь раньше все в порядке было! smile

. Ничто не тормозило. Ничто неглючило"

Весь интернет трубит, что не рекомендуется обращается к VCL из дополнительных потоков. Чужие ошибки привели в такому заключению?
Мне не разу не доводилось видеть человека падающего с большой высоты и разбивающегося. Но все говорят, что человек в 99.9% умирает.
И я им верю, хотя сам не проверял. Чужие ошибки очень полезны. Сомневаетесь - пробуйте (я не по поводу прыжков).

Это сообщение отредактировал(а) Gwire - 13.2.2012, 14:51

MetalFan

Дата 13.2.2012, 15:50 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Gwire, да нет, твой код явных ошибок не содержит. Но к некоторым частям можно придраться "по-мелочи")
К примеру:

В конструкторе потока совершенно необязательно отдавать в предка Suspended=true, а затем делать Resume.
Для синхронизации, имхо, лучше использовать обертки из SyncObjs.
Вместо бесконечного ожидания события в Execute лучше использовать ожидание по таймауту.
Спорный момент с использованием потоконезащищенной InProcess... для получения/установки ее значения безопаснее использовать Interlocked функции, либо вообще использовать объект синхронизации вместо переменной.

Цитата(Gwire @ 13.2.2012, 14:38

)

Весь интернет трубит, что не рекомендуется обращается к VCL

Хм, а самому проверить и убедиться, что НЕ СТОИТ обращаться к визуальным компонентам из доп. потоков разве на столько сложно?
Практически весь код VCL написан без учета использования в н-ких потоках. Никаких синхронизаций, разделенного доступа и т.п.

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

There are always someone smarter than you...

Gwire

Дата 20.2.2012, 10:59 (ссылка)

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

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 216
Регистрация: 7.8.2007
Где: Николаев

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

Цитата(MetalFan @ 13.2.2012, 15:50

)

а самому проверить и убедиться, что НЕ СТОИТ обращаться к визуальным компонентам из доп. потоков разве на столько сложно?

Для этого нужно хорошее понимание этой области.

Придумать такой пример, чтобы он выявил проблемы - это тоже задача.
И не только с потоками, в любой области.

На счет InProcess - действительно упустил моментик. Можно критическую секцию использовать. (uses SyncObjs ... TCriticalSection)

Это сообщение отредактировал(а) Gwire - 20.2.2012, 11:08

Gwire

Дата 26.2.2012, 21:17 (ссылка)

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

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 216
Регистрация: 7.8.2007
Где: Николаев

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

Сидел плевал в потолок - посетила мысль как модернизировать код. Захотелось поделится и обсудить степень улучшения:

Цитата(Код приведен как цитаты с исправлениями @ 9.2.2012, 12:59

)

Код


    procedure pars;
    function get_InProcess: Boolean; // добавить функцию get_InProcess
  protected
    Process    : THandle; // заменить Boolean на THandle
    BellTarget : HWND;
    Barrier    : THandle;
    procedure DoPars;
    procedure Execute; override;
  public
    constructor Create(BellTarget: HWND); reintroduce;
    destructor Destroy; override;
    function ExecuteFor(aS1, aS2, aS3, aS4, aS5: String): Boolean;
    property InProcess: Boolean read get_InProcess; // заменить Process на get_InProcess

Код


constructor TParsThread.Create(BellTarget: HWND);
begin
    . . .
    Process:= CreateEvent(nil, True, False, nil); // заменить False на ..<--
    . . .
end;

Код


    try
        SetEvent(Process); // заменить Process:= True на ..<--
        pars;
    finally
        ResetEvent(Process); // заменить Process:= False на ..<--
    end;

Код


// реализовать функцию
function TParsThread.get_InProcess: Boolean;
begin
    Result:= WaitForSingleObject(Process, 0) = WAIT_OBJECT_0;
end;

Типа убрал потоко-незащищенность InProcess без Критической секции...

Цитата(MetalFan @ 13.2.2012, 15:50

)

либо вообще использовать объект синхронизации вместо переменной.

Это сообщение отредактировал(а) Gwire - 26.2.2012, 21:36

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