Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: WinAPI и системное программирование > Потоки, организация

Автор: bagos 2.2.2009, 06:11

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

Необходимо реализовать работу функций программы с использованием потоков.

Более подробное описание задачи потоков:

При старте программы возможны два варианта:
(А).Программа запускается впервые,поэтому запускается поток ThrStartFirst. Этот поток скачивает с сайта страницу, парсит нужные данные и добавляет их в более расширенный компонент listbox(у листбокса есть свойства text,text1,text2,text3). В то время как работает ThrStartFirst, запускается следующий поток ThrStratAnalys, который берет по очереди каждый итем листбокса, вытаскивает свойство text и скачивает страницу с интернета, уже анализируя полученные данные и сохраняя в определенной структуре в файл.В это же время должен работать еще один поток ThrUpdate. Он скачивает всю туже страницу и наблюдает за появлением новых данных,удалением тех которые уже удалены с той страницы в интернете, и изменением каких то данных.( запускаться поток должен через определенное заданное время)

Вариант (В). Программа запущенна не впервые. В листбокс заносятся данные из сохраненных файлов(учитывая что вариант А полностью отработал в предыдущей загрузке, если нет то скачиваются файлы, которые не были скачаны в пером запуске А). Как только данные занесены, а это происходит весьма быстро так как файлы находяятся на диске в формате txt, то запускается поток ThrUpdate, выполняет те же операции что и в варианте А. Идеально было, если б таких ThrUpdate было больше одного(т.е.ThrUpdate1,2,3,4... которые выполняли свои функции с данными, не обязательно изменявшие данные в листбоксе).

Изучал работу критических секций,мьютексов, семафоров и других вариантов синхронизации (то что выложил Петрович). Но понять пока еще трудно. Надеюсь на помощь в создании алгоритмов. Надеюсь услышать советы: что лучше использовать в моем случае, на что обратить внимание.
P.S. Программа будет работать с моим сайтом. Для скачивания содержимого страниц используется idhttp.
Заранее благодарен.

Автор: bagos 3.2.2009, 20:43

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

Хочу попробовать сделать через onterminate.
Т.е. в мэйнтреде создаю procedure HandleOnTerminate(Sender:TObject);

MyThread.OnTerminate := HandleOnTerminate;

procedure TForm1.HandleOnTerminate(Sender:TObject);
begin
тут нужно описать принятие данных,но как это будет выглядеть?
куда в потоке записывать данные чтобы потом их можно было в этой процедуре обработать?
end;

Автор: MetalFan 3.2.2009, 22:43

Цитата(bagos @ 3.2.2009, 20:43

)

куда в потоке записывать данные чтобы потом их можно было в этой процедуре обработать?

например через поле класса-потока.

Автор: bagos 3.2.2009, 23:08

Сделал так:\

Код


List:TList;
List_count:integer;

var
  mess: PRecord;
..
try
      New(mess);
      List.Add(mess);
      Inc(List_count);
finnaly
...

  try
    for i := 0 to potok.List_count - 1 do
    begin
      mess := potok.List.Items[i];
      ...
    end;
  finally
    Dispose(mess);
  end;

утечки памяти не будет?

Автор: MetalFan 4.2.2009, 12:29

Цитата(bagos @ 3.2.2009, 23:08

)

Сделал так:\

молодцом! утечка будет в строке 23.
з.ы. ты бы еще меньше кода привел, чтобы все сразу в телепаты записались.

Автор: bagos 5.2.2009, 03:51

Вот два юнита. В таймере последующие разы поток не запускается, со временем все нормально, почему то not assigned(potok) возвращает что поток вроде как есть. хотя freeonterminate = true; в чем дело? Хочу сделать чтобы после первого запуска поток, в следующие разу он запускался через 5 сек.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

const
  wm_buf = wm_app + 1234;

type
  TForm1 = class(TForm)
    btn1: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Timer1: TTimer;
    Button1: TButton;
    procedure btn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure handleonterminate(sender: TObject);
    procedure handlenewdata(var message: TMessage); message wm_buf;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Time_end, delta: TDateTime;
implementation

uses Unit2;

{$R *.dfm}
var
  potok: TTest;

procedure TForm1.btn1Click(Sender: TObject);
begin
  potok := TTest.create(form1.Handle, 'http://www.delphimaster.ru/cgi-bin/forum.pl?n=18', wm_buf);
  potok.OnTerminate := handleonterminate;
end;




procedure TForm1.handlenewdata(var message: TMessage);
var mess: PRecord;
begin
  try
    mess := Pointer(message.LParam);
    if listbox1.Items.IndexOf(mess^.name) = -1 then
    begin
      ListBox1.Items.Add(mess^.name);
      ListBox2.Items.Add(mess^.tema);
    end;
    Dispose(mess);
  except
    ShowMessage('Error!');
  end;

end;

procedure TForm1.handleonterminate(sender: TObject);
begin
  Time_end := Now + Delta;
end;

      {
procedure TForm1.handleonterminate(sender: TObject);
var mess: PRecord;
  i: integer;
begin
  try
    for i := 0 to potok.List.Count - 1 do
    begin
      mess := potok.List.Items[i];
      mmo1.Lines.Add('Имя: ' + mess.name + ', Тема: ' + mess.tema);
    end;
  finally
    Dispose(mess);
  end;
end;   }

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Time_end <> 0 then
    if (Now >= Time_end) and not Assigned(potok) then
      potok := TTest.create(form1.Handle, 'http://www.delphimaster.ru/cgi-bin/forum.pl?n=18', wm_buf);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Time_end := StrToTime('00:00:00');
  delta := StrToTime('00:00:05');
end;

end.
unit Unit2;

interface

uses
  Classes, idhttp, unit1, StrUtils, windows, SysUtils;

type
  PRecord = ^TRecord;
  TRecord = record
    name: string[50];
    tema: string[150];
  end;



type
  TTest = class(TThread)
  private
    http: tidhttp;
    page: string;
    FUrl: string;
    hwnd: THandle;
    FMsg: Integer;
  protected
    procedure Execute; override;
    procedure PostRecord(Rec:PRecord);
  public
    constructor Create(h: THandle; Url: string;aMsg:Integer); overload;
    destructor Destroy; override;
  end;

implementation


constructor TTest.Create(h: THandle; Url: string; aMsg:Integer);
begin
  inherited Create(True);
  FUrl := url;
  hwnd := h;
  FMsg := aMsg;
  http := TIdHTTP.Create(nil);
  Priority := tpNormal;
  FreeOnTerminate := True;
  Resume;
end;

destructor TTest.destroy;
begin
  http.Free;
  inherited;
end;

procedure TTest.Execute;
var
  index_name, count_name: Integer;
  index_tema, count_tema: Integer;
  mess: PRecord;
begin
  page := http.Get(FUrl);
  index_tema := 0;
  index_name := 0;
  count_name := 0;
  count_tema := 0;
  index_tema := PosEx('&n=18">', page, count_tema);
  index_name := PosEx('<nobr><i>', page, count_name);
  repeat
    count_name := PosEx('</i>', page, index_name);
    count_tema := PosEx('</a>', page, index_tema);
    try
      Sleep(1);
      New(mess);
      mess^.tema := Copy(page, index_tema + 7, count_tema - index_tema - 7);
      mess^.name := Copy(page, index_name + 9, count_name - index_name - 9);
      PostRecord(mess);
    finally
    end;
    index_name := PosEx('<nobr><i>', page, count_name);
    index_tema := PosEx('&n=18">', page, count_tema);
  until index_name = 0;
end;



procedure TTest.PostRecord(Rec: PRecord);
begin
  PostMessage(hwnd, FMsg, 0, Integer(Rec));
end;

end.

Автор: Felan 5.2.2009, 07:43

Во первых

Код


wm_buf = wm_app + 1234;

не правильно, а правильно

Код


wm_buf = wm_user + 1;

Во вторых, поток нельзя запустить снова, после того, как он завершен. Поток либо есть, либо нет. Если он есть, то он может быть остановлен, но не закончен.

Инными словами, если ты используешь TThread то тебе надо в методе execute организовать цикл между итерациями которого будет 5 сек. Тогда получится то, что ты хочешь. Вообще поищи в сети книгу "Многопоточность - как это делается в Delphi". Очень хороша. smile

Тебе надо что-то типа такого:

Код


procedure TPinger.Execute;
var
  vErrMsg: String;
begin
  SetName;

  while (not Terminated) do
    Begin
      try
        fEventStopReady.SetEvent();
        fEventStartStop.WaitFor(INFINITE);
        fEventStopReady.ResetEvent();

        If Terminated then
          Continue;

        if (GetTickCount() - getTimeCount()) > getRequestInterval() then
          begin
            try
              Monitoring();
            finally
              setTimeCount(GetTickCount());
            end;
          end;

        //пауза что бы поток не кушал такты процессора слишком сильно
        Sleep(10);
      except
        on E: Exception do
          begin
            setIsURLForPingVisible( False );
            vErrMsg := Format('(%s) Ошибка в поточной процедуре (%s), поток будет остановлен. <%s>', [ClassName, getURLPingerID(), e.Message]);
            fLogger.Error(vErrMsg);
            StopWithoutWait();
            DoCallback(e.HelpContext, vErrMsg, 0);
          end;
      end;
    end;
end;

...

procedure TPinger.Monitoring;
Var
  vCurrentURL: String;
  vMsg: String;
  vParams: String;
begin
  IdHTTP := TIdHTTP.Create;
  try
    IdHTTP.HandleRedirects := true;
    IdHTTP.Request.Connection := 'close';
    IdHTTP.AllowCookies := false;
    IdHTTP.ReadTimeout := getReadTimeOut();
    IdHTTP.ConnectTimeout := getConnectionTimeout();
    //Настройка прокси, если надо
    if getUseProxy() then
      begin
        IdHTTP.ProxyParams.BasicAuthentication := getProxyUseBasicAuth();
        IdHTTP.ProxyParams.ProxyPassword := getProxyPassword();
        IdHTTP.ProxyParams.ProxyPort := getProxyPort();
        IdHTTP.ProxyParams.ProxyServer := getProxyURL();
        IdHTTP.ProxyParams.ProxyUsername := getProxyLogin;
      end;
    vCurrentURL := getUrlForPing();
    vParams := getAdditionalURLParams();

    if (vParams <> '') then
      vCurrentURL := vCurrentURL + '?' + vParams;

    try
      IdHTTP.Get( vCurrentURL );

      if IdHTTP.ResponseCode <> HTTP_GET_URL_OK_CODE then
        begin
          vMsg := Format('(%s) Результат пинга (%s: %s) <%s: %d>', [ClassName, getURLPingerID(), vCurrentURL, ERR_URL_UNAVALABLE_MSG, IdHTTP.ResponseCode]);
          setIsURLForPingVisible( False );
        end
      else
        begin
          vMsg := Format('(%s) Результат пинга (%s: %s) <%s: %d>', [ClassName, getURLPingerID(), vCurrentURL, ERR_URL_AVALABLE_MSG, IdHTTP.ResponseCode]);
          setIsURLForPingVisible( True );
        end;
      fLogger.Debug(vMsg);
      DoCallback(0, vMsg, IdHTTP.ResponseCode);
    except
      on E: Exception do
        begin
          setIsURLForPingVisible( False );
          vMsg := Format('(%s) Ошибка при выполнении пинга (%s: %s) <%s>: %d', [ClassName, getURLPingerID(), vCurrentURL, e.Message, e.HelpContext]);
          fLogger.Error(vMsg);
          DoCallback(e.HelpContext, vMsg, 0);
        end;
    end;
  finally
    FreeAndNil(IdHTTP);
  end;
end;

...

procedure TPinger.Start;
begin
  if not getIsStarted then
    begin
      fLogger.Debug(Format('(%s) Запуск потока объекта пингера URL: %s', [ClassName, getURLPingerID()]));
      setTimeCount(0);
      fEventStartStop.SetEvent;
      setIsStarted( True );
      fLogger.Debug(Format('(%s) Запущен поток объекта пингера URL: %s', [ClassName, getURLPingerID()]));
    end;
end;

procedure TPinger.Stop;
begin
  if getIsStarted() then
    begin
      StopWithoutWait();
      fEventStopReady.WaitFor( INFINITE );
      fLogger.Debug(Format('(%s) Остановлен поток объекта пингера URL: %s', [ClassName, getURLPingerID()]));
    end;
end;

procedure TPinger.StopWithoutWait();
begin
  fLogger.Debug(Format('(%s) Остановка потока объекта пингера URL: %s', [ClassName, getURLPingerID()]));
  setIsStarted( False );
  fEventStartStop.ResetEvent();
end;

...

constructor TPinger.Create(aLogger: IiaSimpleLog; aURLPingerID: string);
begin
  inherited Create(True);

  Priority := tpLowest;
  FreeOnTerminate := False;

  fCS := TCriticalSection.Create();
  fLogger := aLogger;
  setURLPingerID(aURLPingerID);
  setIsURLForPingVisible(False);
  setIsStarted(False);
  //
  fEventStartStop := TSimpleEvent.Create();
  fEventStartStop.ResetEvent();
  fEventStopReady := TSimpleEvent.Create();
  //
  Resume();

  fLogger.Debug(Format('(%s) Создан объекта пингера URL: %s', [ClassName, getURLPingerID()]));
end;

destructor TPinger.Destroy;
var
  vURLPingerID: String;
begin
  vURLPingerID := getURLPingerID();
  if getIsStarted() then
    Stop();

  Terminate();
  fEventStartStop.SetEvent();

  WaitFor();

  FreeAndNil( fEventStopReady );
  FreeAndNil( fEventStartStop );
  FreeAndNil( fCS );

  inherited Destroy();
  fLogger.Debug(Format('(%s) Уничтожен объект пингера URL: %s', [ClassName, vURLPingerID]));
end;

Где TPinger = class(TThread).

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

Автор: bagos 5.2.2009, 09:13

Спасибо! Сразу вопросы появились:

Чем отличается wm_user от wm_app я так и не понял, ведь оба выполняют одну и туже функцию wm_...+X ?

Поток нельзя запустить снова, после того, как он завершен. Поток либо есть, либо нет. Если он есть, то он может быть остановлен, но не закончен.

Непонятно почему, что мешает мне запустить его снова? А если рассматривать вариант что приложение будет работать 24 часа в сутки, то поток будет работать тоже постоянно? и закончит свою работу только при выходе из программы?

Автор: MetalFan 5.2.2009, 10:09

Цитата(Felan @ 5.2.2009, 07:43

)

Во первых
wm_buf = wm_app + 1234;

не правильно, а правильно
wm_buf = wm_user + 1;

как раз таки наоборот. от WM_USER до WM_APP вполне могут быть уже задействованы для внутренних сообщений VCL или виндовых контролов.

Добавлено через 6 минут и 13 секунд
кстати, в приведенном Felanом коде тоже есть несколько спорных моментов...

Автор: bagos 5.2.2009, 11:47

Приведите пожалуйста небольшой пример, как организовать доступ к listbox несколькими пишущими и читающими потоками с использование postmessage. (критические секции?). Допустим Один добавляет итем, а другой ищет определенный итем и удаляет его или изменяет.

Добавлено через 42 секунды
Видел примеры работы с критическими секциями, так там идет обращение к vcl прямо внутри секции!

Автор: Felan 5.2.2009, 11:50

Цитата(MetalFan @ 5.2.2009, 12:09

)

как раз таки наоборот. от WM_USER до WM_APP вполне могут быть уже задействованы для внутренних сообщений VCL или виндовых контролов.

Хм... ну можно и так сказать... счас еще раз прочитал в MSDN, че-то мутновато как-то...
Типа если окно само себе посылает сообщение или внутренним окнам, то надо от WM_USER плясать, а если в оконную процедуру шлется сообщение извне, но в пределах самого же приложения то от WM_APP...

Посути получается, что WM_APP это сообщения которые должны посылаться окну приложения из самого же приложения, а для всех остальных должно быть WM_USER.

Или я чего не так понял?

Цитата(MetalFan @ 5.2.2009, 12:09

)

кстати, в приведенном Felanом коде тоже есть несколько спорных моментов...

Че за моменты? Валяй, вдруг правда че подправить надо smile

ЗЫЖ Думаю оффтопиком не будет, т.к. автору тоже про это надо послушать.

Добавлено через 4 минуты и 39 секунд

Цитата(bagos @ 5.2.2009, 11:13

)

Чем отличается wm_user от wm_app я так и не понял, ведь оба выполняют одну и туже функцию wm_...+X ?

Ну это, я надеюсь мы сейчас с MetalFanом выясним. smile

Цитата(bagos @ 5.2.2009, 11:13

)

Непонятно почему, что мешает мне запустить его снова? А если рассматривать вариант что приложение будет работать 24 часа в сутки, то поток будет работать тоже постоянно? и закончит свою работу только при выходе из программы?

То, что ты не сможешь его "запустить снова". Нужно будет заново создать класс. Если надо что бы он работал 24 часа в сутки, то надо делать цикл, который будет выполняться эти самые 24 часа. При этом ему не обязательно работать постоянно. Его можно приостановить. Но если ты его завершишь, то все, надо будет делать заново. Это в больше степени отностися к TThread. Если делать на API там немного подругому, но суть та же, если поток завершился (произошел выход из поточной процедуры), то его (поток) надо создавать заново.

Автор: bagos 5.2.2009, 12:04

Опа, извиняюсь, неправильно сказал. Не запустить, а создать smile

)) Создать заново можно ведь)

Автор: bagos 5.2.2009, 12:28

Можно обращаться к форме как здесь?

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, unit2;
const
  WM_DATA_IN_BUF = WM_APP + 1000;
  MaxMemoLines = 20;
type
  TForm1 = class(TForm)
    StartBtn: TButton;
    StopBtn: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure StartBtnClick(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FStringSectInit: boolean;
    FPrimeThread: TPrimeThrd2;
    FStringBuf: TStringList;
    procedure UpdateButtons;
    procedure HandleNewData(var Message: TMessage); message WM_DATA_IN_BUF;
    { Private declarations }
  public
    { Public declarations }
    StringSection: TRTLCriticalSection;
    property StringBuf: TStringList read FStringBuf write FStringBuf;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure tform1.UpdateButtons;
begin
  StopBtn.Enabled := FStringSectInit;
  StartBtn.Enabled := not FStringSectInit;
end;

procedure TForm1.StartBtnClick(Sender: TObject);
begin
  if not FStringSectInit then
  begin
    InitializeCriticalSection(StringSection);
    FStringBuf := TStringList.Create;
    FStringSectInit := true;
    FPrimeThread := TPrimeThrd2.Create(true);
    SetThreadPriority(FPrimeThread.Handle, THREAD_PRIORITY_BELOW_NORMAL);
    try
      FPrimeThread.StartNum := StrToInt(edit1.Text);
    except
      on EConvertError do FPrimeThread.StartNum := 2;
    end;
    FPrimeThread.Resume;
  end;
  UpdateButtons;
end;

procedure TForm1.StopBtnClick(Sender: TObject);
begin
  if FStringSectInit then
  begin
    with FPrimeThread do
    begin
      Terminate;
      WaitFor;
      Free;
    end;
    FPrimeThread := nil;
    FStringBuf.Free;
    FStringBuf := nil;
    DeleteCriticalSection(StringSection);
    FStringSectInit := false;
  end;
  UpdateButtons;
end;

procedure tform1.HandleNewData(var Message: TMessage);
begin
  if FStringSectInit then
  begin
    EnterCriticalSection(StringSection);
    memo1.Lines.Add(FStringBuf.Strings[0]);
    FStringBuf.Delete(0);
    LeaveCriticalSection(StringSection);
    if memo1.Lines.Count > MaxMemoLines then
      Memo1.Lines.Delete(0);
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  StopBtnClick(Self);
end;

end.

unit Unit2;

interface

uses
  Classes,windows;

type
  TPrimeThrd2 = class(TThread)
  private
    FStartNum: integer;
    function IsPrime(TestNo: integer): boolean;
  protected
    procedure Execute; override;
      public
    property StartNum: integer read FStartNum write FStartNum;
  end;

implementation


uses Unit1,SysUtils;

function TPrimeThrd2.IsPrime(TestNo: integer): boolean;
var
  iter: integer;
begin
  result := true;
  if TestNo < 0 then
    result := false;
  if TestNo <= 2 then
    exit;
  iter := 2;
  while (iter < TestNo) and (not terminated) do
  begin
    if (TestNo mod iter) = 0 then
    begin
      result := false;
      exit;
    end;
    Inc(iter);
  end;
end;

procedure TPrimeThrd2.Execute;
 var
  CurrentNum: integer;
begin
  CurrentNum := FStartNum;
  while not Terminated do
  begin
    if IsPrime(CurrentNum) then
    begin
      EnterCriticalSection(form1.StringSection);
      form1.StringBuf.Add(IntToStr(CurrentNum) + ' is prime.');
      LeaveCriticalSection(form1.StringSection);
      PostMessage(form1.Handle, WM_DATA_IN_BUF, 0, 0);
    end;
    Inc(CurrentNum);
  end;
end;

end.