Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: [1] 2 3 4 5 6 7 8 9 10 .. 19   вперед  Ctrl
 Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Собственно, сам шаблон с небольшими комментариями именно в тех местах, которые нужны на обывательском уровне, чтобы только добавить свой код.
+
unit WThread;

interface

uses
    Classes,
    Windows,
    Messages,
    SysUtils;

type
    TWThread = class;

    // событие на получение строки из потока
    TWThreadReceiveString = procedure(Sender: TWThread; const Text: string) of object;
    // событие на получение числа из потока
    TWThreadReceiveInt = procedure(Sender: TWThread; const Int: Integer) of object;
    // событие на получение строки и числа из потока
    TWThreadReceiveStringWord = procedure(Sender: TWThread; const Text: string; const Wrd: Word) of object;
    // событие на получение двух чисел из потока
    TWThreadReceiveIntWord = procedure(Sender: TWThread; const Int: Integer; const Wrd: Word) of object;

    TWThread = class(TThread)
    private
        FToolWindow: THandle;
        hCloseEvent: THandle;
        FOnThreadReceviceString: TWThreadReceiveString;
        FOnThreadReceiveInt: TWThreadReceiveInt;
        FOnThreadReceiveStringWord: TWThreadReceiveStringWord;
        FOnThreadReceiveIntWord: TWThreadReceiveIntWord;
    protected
        procedure WWindowProc(var Msg: TMessage);
        procedure SendString(const Text: string);
        procedure SendInteger(const Int: Integer);
        procedure SendStringWord(const Text: string; const Wrd: Word);
        procedure SendIntegerWord(const Int: Integer; const Wrd: Word);
        procedure DoThreadReceiveString(const Text: string);
        procedure Execute; override; // шаблон процедуры
    public
        constructor Create(CreateSuspended: Boolean); virtual;
        destructor Destroy; override;
        // отправка любого сообщения в поток
        function SendMessageToThread(AMsg: UInt; wParam: WPARAM; lParam: LPARAM): BOOL;
        // отправка строки в поток
        function SendStringToThread(const Text: string): boolean;
        // остановка потока по феншую
        function StopThread: boolean;
        // события на получение данных из потока
        property OnThreadReceviceString: TWThreadReceiveString read FOnThreadReceviceString write FOnThreadReceviceString;
        property OnThreadReceiveInt: TWThreadReceiveInt read FOnThreadReceiveInt write FOnThreadReceiveInt;
        property OnThreadReceiveStringWord: TWThreadReceiveStringWord read FOnThreadReceiveStringWord write FOnThreadReceiveStringWord;
        property OnThreadReceiveIntWord: TWThreadReceiveIntWord read FOnThreadReceiveIntWord write FOnThreadReceiveIntWord;
    end;

implementation

const
    WM_BASE             = WM_USER + $100;
    WM_STRING           = WM_BASE + 1;
    WM_INT              = WM_BASE + 2;
    WM_STRING_WORD      = WM_BASE + 3;
    WM_INT_WORD         = WM_BASE + 4;

    WM_MAX              = WM_INT_WORD;

{ TWThread }

constructor TWThread.Create(CreateSuspended: Boolean);
begin
    inherited;
    FToolWindow := AllocateHWnd(WWindowProc);
    hCloseEvent := CreateEvent(nil, true, false, nil);
end;

destructor TWThread.Destroy;
begin
    CloseHandle(hCloseEvent);
    DeallocateHWnd(FToolWindow);
    inherited;
end;

procedure TWThread.DoThreadReceiveString(const Text: string);
begin
    if Assigned(FOnThreadReceviceString) then
        FOnThreadReceviceString(Self, Text);
end;

function TWThread.SendMessageToThread(AMsg: UInt; wParam: WPARAM; lParam: LPARAM): BOOL;
begin
    result := PostThreadMessage(ThreadID, AMsg, wParam, lParam);
end;

function TWThread.SendStringToThread(const Text: string): boolean;
var buf: LPARAM;
begin
    buf := 0;
    String(Buf) := Text;
    result := PostThreadMessage(ThreadID, WM_STRING, 0, buf);
end;

procedure TWThread.Execute;
var
    HandlesToWaitFor: array [0 .. 0] of THandle;
    dwHandleSignaled: DWORD;
    msg: TMsg;
    str: string;
label
    EndOfThread;
begin
    // следующая строка должна быть всегда первой в процедуре, т.к. запускает очередь сообщений для потока
    PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
    HandlesToWaitFor[0] := hCloseEvent;
    // SleepEx не нужен, если подготовительный код до цикла while будет достаточно долго выполняться
    // уточняется опытным путем, иначе очередь сообщений потока не успеет запуститься и сообщения могут улететь в пустоту
    SleepEx(20, false);

    // тестовый пример vvv
    SendString('WThread started');
    // тестовый пример ^^^

    while not Terminated do begin
        if not PeekMessage(msg, 0, WM_BASE, WM_MAX, PM_REMOVE) then begin
            dwHandleSignaled := MsgWaitForMultipleObjects(1, HandlesToWaitFor, false, INFINITE, QS_ALLINPUT);
            case dwHandleSignaled of
                WAIT_OBJECT_0: begin // выставлено событие остановки потока
                    Terminate;
                    goto EndOfThread;
                end;
                WAIT_OBJECT_0 + 1: begin // получено сообщение
                    Continue;
                end;
            end;
        end;
        if msg.hwnd <> 0 then begin
            TranslateMessage(msg);
            DispatchMessage(msg);
            Continue;
        end;
        case msg.message of
            WM_QUIT, WM_CLOSE, WM_DESTROY: begin // оконные сообщения тоже получаем
                Terminate;
                goto EndOfThread;
            end;
            WM_STRING: begin
                LPARAM(str) := msg.lParam;
                // что-нибудь делаем со строкой. например, отправляем обратно

                // тестовый пример vvv
                SendString(Format('received: %s', [str]));
                // тестовый пример ^^^

                str := ''; // "отпускаем" строку после работы с ней
            end;
            WM_INT: begin
                // здесь получаем число в msg.lparam;
            end;
        end;
    end;
EndOfThread:
    // все что создали в начале процедуры, здесь удаляем
end;

procedure TWThread.SendInteger(const Int: Integer);
begin
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_INT, 0, Int);
end;

procedure TWThread.SendIntegerWord(const Int: Integer; const Wrd: Word);
begin
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_INT_WORD, Wrd, Int);
end;

procedure TWThread.SendString(const Text: string);
var buf: LParam;
begin
    buf := 0;
    String(buf) := Text;
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_STRING, 0, buf);
end;

procedure TWThread.SendStringWord(const Text: string; const Wrd: Word);
var buf: LParam;
begin
    buf := 0;
    String(buf) := Text;
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_STRING, Wrd, buf);
end;

function TWThread.StopThread: boolean;
begin
    SetEvent(hCloseEvent);
    SleepEx(1, false);
    result := WaitForSingleObject(Handle, 10000) <> WAIT_TIMEOUT;
end;

procedure TWThread.WWindowProc(var Msg: TMessage);
var str: String;
begin
    case Msg.Msg of
        WM_STRING: begin
            LPARAM(str) := Msg.LParam;
            DoThreadReceiveString(str);
            Msg.Result := 1;
        end;
        WM_INT: begin
            if Assigned(FOnThreadReceiveInt) then
                FOnThreadReceiveInt(Self, Msg.LParam);
            Msg.Result := 1;
        end;
        WM_STRING_WORD: begin
            LPARAM(str) := Msg.LParam;
            if Assigned(FOnThreadReceiveStringWord) then
                FOnThreadReceiveStringWord(Self, str, Msg.WParam);
            Msg.Result := 1;
        end;
        WM_INT_WORD: begin
            if Assigned(FOnThreadReceiveIntWord) then
                FOnThreadReceiveIntWord(Self, Msg.LParam, Msg.WParam);
            Msg.Result := 1;
        end;
    else
        Msg.Result := DefWindowProc(FToolWindow, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;

end.


Тестовый проект. Форма состоит из мemo, и двух кнопок: одна запускает/останавливает поток, другая отправляет строку в поток.
+
unit ThreadTestMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, WThread;

type
  TfrmWThreadTest = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FThread: TWThread;
    procedure ReceiveString(Sender: TWThread; const Text: string);
    procedure StartThread;
    procedure StopThread;
  public
  end;

var
  frmWThreadTest: TfrmWThreadTest;

implementation

{$R *.dfm}

procedure TfrmWThreadTest.Button1Click(Sender: TObject);
begin
    if Assigned(FThread) then
        StopThread
    else
        StartThread;
end;

procedure TfrmWThreadTest.Button2Click(Sender: TObject);
var s: string;
begin
    if Assigned(FThread) and InputQuery('Input', 'Enter text', s) then begin
        Memo1.Lines.Add(Format('-> %s', [s]));
        FThread.SendStringToThread(s);
    end;
end;

procedure TfrmWThreadTest.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if Assigned(FThread) then
        StopThread;
end;

procedure TfrmWThreadTest.FormCreate(Sender: TObject);
begin
    Memo1.Lines.Clear;
end;

procedure TfrmWThreadTest.ReceiveString(Sender: TWThread; const Text: string);
begin
    Memo1.Lines.Add(Format('<- %s', [Text]));
end;

procedure TfrmWThreadTest.StartThread;
begin
    if not Assigned(FThread) then begin
        FThread := TWThread.Create(true);
        FThread.OnThreadReceviceString := ReceiveString;
        FThread.Start;
    end;
end;

procedure TfrmWThreadTest.StopThread;
begin
    if Assigned(FThread) then begin
        if not FThread.StopThread then
            MessageDlg('You dont kill me!', mtError, [mbOk], 0);
        FThread.Free;
        FThread := nil;
    end;
end;

end.


Тестирование было с ReportMemoryLeaksOnShutdown := true; что показало, что память не теряется при многочисленных отправках строк. Delphi XE2.

Вопросы, предложения? :)

Репозитарий на гитхабе: https://github.com/wadman/wthread/
30 сен 13, 13:10    [14900985]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
fd00ch
Member

Откуда: Нижний Новгород
Сообщений: 5913
wadman,

1. KISS
2. RTFM твой WM_STRING - это PSM_SHEETINFO. маловероятно, конечно, что система догадается посласть его твоему окну, но когда догадается таки - ожидаемой строки ты там не найдешь))
3. зачем отправлять всего лишь Word, когда "по ширине" вполне пролазит WPARAM?
30 сен 13, 14:41    [14901875]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
fd00ch
KISS

Не осилил, поясни. Если речь о Terminate и goto, то считай это перестраховкой для начинающего.
fd00ch
твой WM_STRING - это PSM_SHEETINFO.

WM_USER + $100 + 1 <> WM_USER+101
fd00ch
зачем отправлять всего лишь Word, когда "по ширине" вполне пролазит WPARAM?

Можно и так.
30 сен 13, 14:50    [14901950]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
fd00ch
Member

Откуда: Нижний Новгород
Сообщений: 5913
wadman
WM_USER + $100 + 1 <> WM_USER+101
профнепригодность, блин, доллары перестаю замечать

wadman
Не осилил, поясни
зачем писать сложно, когда можно просто? у тебя задача потока в чем заключается?
30 сен 13, 15:09    [14902083]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
fd00ch
у тебя задача потока в чем заключается?

У меня - ни в чем. Свистоперделка Конкретный вопрос задай.
30 сен 13, 15:14    [14902111]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
fd00ch
Member

Откуда: Нижний Новгород
Сообщений: 5913
1. зачем нужен такой поток?
2. зачем потоку нужны сообщающие о принятых данных события, которые не синхронизированы ни с чем?
3. по мотивам п.2. в чьем контексте вызывается TfrmWThreadTest.ReceiveString с обращением к Memo1?
30 сен 13, 15:32    [14902230]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
Aleksey V.P.
Member

Откуда: Москва
Сообщений: 575
wadman,

Не понял для чего шаблон потока. Сделай пояснения, please.
30 сен 13, 15:36    [14902250]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
fd00ch
1. зачем нужен такой поток?
2. зачем потоку нужны сообщающие о принятых данных события, которые не синхронизированы ни с чем?

Это шаблон.
fd00ch
в чьем контексте вызывается TfrmWThreadTest.ReceiveString с обращением к Memo1?

Естественно в главном потоке, который обслуживает VCL. Как и все, что дергается из WWindowProc.
30 сен 13, 15:37    [14902256]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Aleksey V.P.
Сделай пояснения, please.

Для людей, которые создают такие темы:
https://www.sql.ru/forum/1050309/tthread-nuzhna-li-v-privedennom-kode-sinhronizaciya
https://www.sql.ru/forum/1050203/obrashhenie-k-forme-iz-thread
https://www.sql.ru/forum/1049953/osnovy-tthread
30 сен 13, 15:39    [14902265]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
defecator
Member

Откуда:
Сообщений: 39279
Я вижу в тексте слово GOTO - код КГ/АМ
30 сен 13, 15:47    [14902305]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
defecator
Я вижу в тексте слово GOTO - код КГ/АМ

Перед этим Label не заметил?
30 сен 13, 15:49    [14902318]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
Aleksey V.P.
Member

Откуда: Москва
Сообщений: 575
wadman
Для людей, которые создают такие темы:
https://www.sql.ru/forum/1050309/tthread-nuzhna-li-v-privedennom-kode-sinhronizaciya
https://www.sql.ru/forum/1050203/obrashhenie-k-forme-iz-thread
https://www.sql.ru/forum/1049953/osnovy-tthread


Спасиба за пояснения, буэшечку словил. Поясни смысл использования оператора GoTo, без него никак не обойтись?
30 сен 13, 15:50    [14902325]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
Aleksey V.P.
Member

Откуда: Москва
Сообщений: 575
wadman,

Например использовать try .. finally .. end..
30 сен 13, 15:55    [14902353]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Aleksey V.P.
без него никак не обойтись?

Обойтись, тот же break. Только я не сторонник бинарной логики "если, то", то есть если выполняется, как заложено, то нехай буде.
30 сен 13, 15:55    [14902356]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Aleksey V.P.
Например использовать try .. finally .. end..

В этом коде это лишнее. Раз уж такой любитель процедурных вызовов, то try должны расставлены быть в вызываемых процедурах.
30 сен 13, 15:57    [14902366]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
fd00ch
Member

Откуда: Нижний Новгород
Сообщений: 5913
wadman
Естественно в главном потоке, который обслуживает VCL. Как и все, что дергается из WWindowProc.
да, прощелкал, что создание окна идет из конструктора, а не из Execute
30 сен 13, 16:00    [14902375]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
wadman
https://www.sql.ru/forum/1050203/obrashhenie-k-forme-iz-thread

14899112 Пример на основе моего модуля:
1. Добавляется процедура своего парсера.
2. В Execute ловится любой свой код посредством SendMessageToThread и процедура запускается.
3. Из потока вполне себе можно отправлять сообщения: прогресс выполнения, коды действия, диагностические сообщения и т.п.

+
unit WThread;

interface

uses
    Classes,
    Windows,
    Messages,
    SysUtils;

type
    TWThread = class;

    // событие на получение строки из потока
    TWThreadReceiveString = procedure(Sender: TWThread; const Text: string) of object;
    // событие на получение числа из потока
    TWThreadReceiveInt = procedure(Sender: TWThread; const Int: Integer) of object;
    // событие на получение строки и числа из потока
    TWThreadReceiveStringWord = procedure(Sender: TWThread; const Text: string; const DWrd: Word) of object;
    // событие на получение двух чисел из потока
    TWThreadReceiveIntWord = procedure(Sender: TWThread; const Int: Integer; const DWrd: Word) of object;

    TWThread = class(TThread)
    private
        FToolWindow: THandle;
        hCloseEvent: THandle;
        FOnThreadReceviceString: TWThreadReceiveString;
        FOnThreadReceiveInt: TWThreadReceiveInt;
        FOnThreadReceiveStringWord: TWThreadReceiveStringWord;
        FOnThreadReceiveIntWord: TWThreadReceiveIntWord;
    protected
        procedure WWindowProc(var Msg: TMessage);
        procedure SendString(const Text: string);
        procedure SendInteger(const Int: Integer);
        procedure SendStringWord(const Text: string; const Wrd: DWord);
        procedure SendIntegerWord(const Int: Integer; const Wrd: DWord);
        procedure DoThreadReceiveString(const Text: string);
        procedure ParseUrl(const URL: string); // процедура парсера
        procedure Execute; override; // шаблон процедуры
    public
        constructor Create(CreateSuspended: Boolean); virtual;
        destructor Destroy; override;
        // отправка любого сообщения в поток
        function SendMessageToThread(AMsg: UInt; wParam: WPARAM; lParam: LPARAM): BOOL;
        // отправка строки в поток
        function SendStringToThread(const Text: string): boolean;
        // отправка числа и строки в поток
        function SendStringIntToThread(const Text: string; const Wrd: DWord): boolean;
        // остановка потока по феншую
        function StopThread: boolean;
        // события на получение данных из потока
        property OnThreadReceviceString: TWThreadReceiveString read FOnThreadReceviceString write FOnThreadReceviceString;
        property OnThreadReceiveInt: TWThreadReceiveInt read FOnThreadReceiveInt write FOnThreadReceiveInt;
        property OnThreadReceiveStringWord: TWThreadReceiveStringWord read FOnThreadReceiveStringWord write FOnThreadReceiveStringWord;
        property OnThreadReceiveIntWord: TWThreadReceiveIntWord read FOnThreadReceiveIntWord write FOnThreadReceiveIntWord;
    end;

implementation

const
    WM_BASE             = WM_USER + $100;
    WM_STRING           = WM_BASE + 1;
    WM_INT              = WM_BASE + 2;
    WM_STRING_WORD      = WM_BASE + 3;
    WM_INT_WORD         = WM_BASE + 4;

    WM_MAX              = WM_INT_WORD;

{ TWThread }

constructor TWThread.Create(CreateSuspended: Boolean);
begin
    inherited;
    FToolWindow := AllocateHWnd(WWindowProc);
    hCloseEvent := CreateEvent(nil, true, false, nil);
end;

destructor TWThread.Destroy;
begin
    CloseHandle(hCloseEvent);
    DeallocateHWnd(FToolWindow);
    inherited;
end;

procedure TWThread.DoThreadReceiveString(const Text: string);
begin
    if Assigned(FOnThreadReceviceString) then
        FOnThreadReceviceString(Self, Text);
end;

function TWThread.SendMessageToThread(AMsg: UInt; wParam: WPARAM; lParam: LPARAM): BOOL;
begin
    result := PostThreadMessage(ThreadID, AMsg, wParam, lParam);
end;

function TWThread.SendStringToThread(const Text: string): boolean;
var buf: LPARAM;
begin
    buf := 0;
    String(Buf) := Text;
    result := PostThreadMessage(ThreadID, WM_STRING, 0, buf);
end;

function TWThread.SendStringIntToThread(const Text: string; const Wrd: DWord): boolean;
var buf: LPARAM;
begin
    buf := 0;
    String(Buf) := Text;
    result := PostThreadMessage(ThreadID, WM_STRING_WORD, Wrd, buf);
end;

procedure TWThread.Execute;
var
    HandlesToWaitFor: array [0 .. 0] of THandle;
    dwHandleSignaled: DWORD;
    msg: TMsg;
    str: string;
    dw: DWord;
label
    EndOfThread;
begin
    // следующая строка должна быть всегда первой в процедуре, т.к. запускает очередь сообщений для потока
    PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
    HandlesToWaitFor[0] := hCloseEvent;
    // SleepEx не нужен, если подготовительный код до цикла while будет достаточно долго выполняться
    // уточняется опытным путем, иначе очередь сообщений потока не успеет запуститься и сообщения могут улететь в пустоту
    SleepEx(20, false);

    // тестовый пример vvv
    SendString('WThread started');
    // тестовый пример ^^^

    while not Terminated do begin
        if not PeekMessage(msg, 0, WM_BASE, WM_MAX, PM_REMOVE) then begin
            dwHandleSignaled := MsgWaitForMultipleObjects(1, HandlesToWaitFor, false, INFINITE, QS_ALLINPUT);
            case dwHandleSignaled of
                WAIT_OBJECT_0: begin // выставлено событие остановки потока
                    Terminate;
                    goto EndOfThread;
                end;
                WAIT_OBJECT_0 + 1: begin // получено сообщение
                    Continue;
                end;
            end;
        end;
        if msg.hwnd <> 0 then begin
            TranslateMessage(msg);
            DispatchMessage(msg);
            Continue;
        end;
        case msg.message of
            WM_QUIT, WM_CLOSE, WM_DESTROY: begin // оконные сообщения тоже получаем
                Terminate;
                goto EndOfThread;
            end;
            WM_STRING: begin
                LPARAM(str) := msg.lParam;
                // что-нибудь делаем со строкой. например, отправляем обратно

                // тестовый пример vvv
                SendString(Format('received: %s', [str]));
                // тестовый пример ^^^

                str := ''; // "отпускаем" строку после работы с ней
            end;
            WM_INT: begin
                // здесь получаем число в msg.lparam;
            end;
            WM_STRING_WORD: begin
                dw := msg.wParam;
                LPARAM(str) := msg.lParam;
                // что-нибудь делаем со строкой и числом.
                // например число было 77
                case dw of
                    77: ParseUrl(str);
                end;

                str := ''; // "отпускаем" строку после работы с ней
            end;
        end;
    end;
EndOfThread:
    // все что создали в начале процедуры, здесь удаляем
end;

procedure TWThread.ParseUrl(const URL: string);
begin
    SendString('Begin parsing...');
    // парсер
    SendString('Done parsing...');
end;

procedure TWThread.SendInteger(const Int: Integer);
begin
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_INT, 0, Int);
end;

procedure TWThread.SendIntegerWord(const Int: Integer; const Wrd: DWord);
begin
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_INT_WORD, Wrd, Int);
end;

procedure TWThread.SendString(const Text: string);
var buf: LParam;
begin
    buf := 0;
    String(buf) := Text;
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_STRING, 0, buf);
end;

procedure TWThread.SendStringWord(const Text: string; const Wrd: DWord);
var buf: LParam;
begin
    buf := 0;
    String(buf) := Text;
    if FToolWindow <> 0 then
        PostMessage(FToolWindow, WM_STRING, Wrd, buf);
end;

function TWThread.StopThread: boolean;
begin
    SetEvent(hCloseEvent);
    SleepEx(1, false);
    result := WaitForSingleObject(Handle, 10000) <> WAIT_TIMEOUT;
end;

procedure TWThread.WWindowProc(var Msg: TMessage);
var str: String;
begin
    case Msg.Msg of
        WM_STRING: begin
            LPARAM(str) := Msg.LParam;
            DoThreadReceiveString(str);
            Msg.Result := 1;
        end;
        WM_INT: begin
            if Assigned(FOnThreadReceiveInt) then
                FOnThreadReceiveInt(Self, Msg.LParam);
            Msg.Result := 1;
        end;
        WM_STRING_WORD: begin
            LPARAM(str) := Msg.LParam;
            if Assigned(FOnThreadReceiveStringWord) then
                FOnThreadReceiveStringWord(Self, str, Msg.WParam);
            Msg.Result := 1;
        end;
        WM_INT_WORD: begin
            if Assigned(FOnThreadReceiveIntWord) then
                FOnThreadReceiveIntWord(Self, Msg.LParam, Msg.WParam);
            Msg.Result := 1;
        end;
    else
        Msg.Result := DefWindowProc(FToolWindow, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;

end.


То есть поток выполняется всегда, но когда не парсит, то ожидает "приказа" в виде SendStringIntToThread(77, 'http://ya.ru')
30 сен 13, 16:19    [14902497]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
Dimonka
Member

Откуда:
Сообщений: 1179
wadman,

Блин, как-то всё необоснованно сложно завернуто.
Нет никакого стека для присланных URL, если поток не пропарсил предыдущий URL, то передать следующий URL будет проблематично. Особенно если это связано с большими ресурсными затратами или с обращением к устройствам ввода/вывода.

Предлагаю изменить для теста код твоего потока следующим образом:
procedure TWThread.ParseUrl(const URL: string);
begin
SendString('Begin parsing...');
// парсер
Sleep(1000);
SendString('Done parsing...');
end;

и попробовать пообращаться к потоку раз в пол секунды с разными урлами. Сколько урлов пропарсит твой поток?
30 сен 13, 17:19    [14902835]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Dimonka
Нет никакого стека для присланных URL

Откуда такая информация?
Dimonka
Сколько урлов пропарсит твой поток?

Столько, сколько вмещает очередь сообщений ОС.
30 сен 13, 17:28    [14902890]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Но именно в случае парсером страниц я бы сделал не один, а 50 потоков, регулируемых из главного, а не пихал бы всю работу в один доп поток. И при этом анализировал бы занятость потоков. Благо для этого (диалога между основным и доп потоком) тут все предусмотрено.
30 сен 13, 17:38    [14902937]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Завтра напишу чуть более сложный пример для 50-ти потоков, которые стартуют случайно, отсчитывают случайное количество секунд и сообщают о своей работу основному потоку. Никаких тормозов интерфейса при этом не будет. Примерно такой метод работы с устройствами у меня используется на производстве.
30 сен 13, 18:32    [14903287]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
Dimonka
Member

Откуда:
Сообщений: 1179
wadman
Dimonka
Нет никакого стека для присланных URL

Откуда такая информация?
Dimonka
Сколько урлов пропарсит твой поток?

Столько, сколько вмещает очередь сообщений ОС.

Ну так вот в том-то и дело, что поток использует очередь сообщений, а не очередь заданий. Отправителю надо будет хранить урлы, пока их не обработает поток.
Напиши код по обработке 2х урлов применро так:
s := "123";
Thread.DoParseURL(s);
s := "321";
Thread.DoParseURL(s);
s := "";
и посмотри, что он тебе выдаст.

Только не забудь поставить sleep(20) в парсинг урлов для изображения непосильного труда.

зы
DoParseURL() должен посылать какие надо команды для парсинга.
30 сен 13, 18:55    [14903409]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 25560
Dimonka, сам напиши DoParseUrl и покажи, что в нем не так. У меня впечатление, что ты не понимаешь до конца, как это работает.
30 сен 13, 19:23    [14903515]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
Гаджимурадов Рустам
Member

Откуда:
Сообщений: 59987

2 wadman

Не вчитывался ни в класс, ни в шаблон, ни в ваш диалог,
но на беглый взгляд - я бы ни в коем, НИ В КОЕМ случае
не использовал сообщения/события для обмена данными,
только для сигнализации. Тем более в шаблоне потока.

Posted via ActualForum NNTP Server 1.5

30 сен 13, 19:30    [14903539]     Ответить | Цитировать Сообщить модератору
 Re: Шаблон класса для работы с потоком (WThread, Thread)  [new]
Dimonka
Member

Откуда:
Сообщений: 1179
wadman,

я так полагаю, это будет что-то вроде этого?

  
procedure TWThread.DoParseURL(const URL: string);
begin
  SendStringWord(URL, 77);
end;


Можешь тестировать :)
30 сен 13, 19:36    [14903554]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: [1] 2 3 4 5 6 7 8 9 10 .. 19   вперед  Ctrl
Все форумы / Delphi Ответить