![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
||||
|
||||
|
Собственно была программа на D7, ввиду запутанности кода и в связи с переходом на XE4 решил переписать с нуля.
В частности, из главного окна, в цикле запускаются потоки, в потоке IdHTTP проверяет наличие файла и возвращает строку в зависимости от ответа. Когда наследник TThread описан в модуле главного окна все просто Код:
...
Synchronize(WriteRespons);
end;
procedure TDownload.WriteRespons;
begin Form1.Memo1.Lines.Append(ResStr);
Form1.ProgressBar2.Position:= trcount;
{и т.д.}Вроде бы вариант - посылка сообщения, но в сообщении нельзя передать строку, можно передать указатель, а с указателями для меня не все ясно. Где-то наткнулся на идею обработать OnTerminate Код:
unit MyThreads;
...
type
TMyThread = class(TThread)
...
public
property Str: string read FStr write FStr;
end;
unit Unit1;
...
var
Form1: TForm1;
thr: TMyThread;
...
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
ListBox1.Clear;
for i := 0 to 12 do
begin
thr:= TMyThread.Create(True);
thr.FreeOnTerminate:= True;
thr.OnTerminate:= Form1.MyProc;
thr.Start;
end;
end;
procedure TForm1.MyProc(Sender: TObject);
begin
ListBox1.Items.Append('Str - '+thr.Str);
end;Вообще в Дельфи стандартно и создается отдельный модуль (New>Other>Thread Object) и в заготовке модуля в комментарии говорится о необходимости использования Synchronize, значит есть какой то способ обмена данными. А во всех статьях "Потоки для чайников" пишут - " ... для простоты опишем новый класс в главном модуле ...", хоть кто-нибудь привел бы пример с отдельным unit-ом. Похоже я как всегда упускаю что-то до такой степени очевидное, что об этом ни кто не пишет. |
|
#2
|
|||
|
|||
|
Да вариантов масса.
Кстати, отправлять через сообщения можно все-что угодно, в т.ч. целые структуры. Там только один момент. Если надо отправлять после полной сметри потока (т.е. перед ней, затем поток умирает, а когда произойдет обработка переданной инфы - фиг знает), то надо выделять память для этого в куче (ну и желательно блокировть ее). Теперь по синхронизации. Synchronize никто не отменял (это для синхронизации с главным тредом). Если у тебя потоков много, то придется еще и синхронизировать их между собой через критические секции. Вот маленький пример с использованием делегата (это шаблон проектирования такой): Поток: Код:
unit Unit2;
interface
uses
System.Classes;
type
TCallMainFormEvent = procedure (AMsg : String) of object;
TWorkerThread = class(TThread)
private
{ Private declarations }
FCallBack : TCallMainFormEvent;
FMsg : String;
FID : Integer;
procedure CallMainForm;
protected
procedure Execute; override;
public
constructor Create(CreateSuspned : Boolean; CallBack : TCallMainFormEvent);
end;
implementation
{
Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TWorkerThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
or
Synchronize(
procedure
begin
Form1.Caption := 'Updated in thread via an anonymous method'
end
)
);
where an anonymous method is passed.
Similarly, the developer can call the Queue method with similar parameters as
above, instead passing another TThread class as the first parameter, putting
the calling thread in a queue with the other thread.
}
{ TWorkerThread }
uses
System.SysUtils, SyncObjs;
var
ThreadSync : TCriticalSection;
constructor TWorkerThread.Create(CreateSuspned : Boolean; CallBack : TCallMainFormEvent);
begin
FCallBack := CallBack;
FMsg := ''; // Just in case
FID := Random(2000000000); // Just generate random ID for each thread
inherited Create(CreateSuspned);
end;
procedure TWorkerThread.Execute;
var
thrdDelay : Integer;
begin
FMsg := 'Thread started.';
Synchronize(CallMainForm);
thrdDelay := Random(5000); // random delay 0 - 5 second
Fmsg := Format('Thread delay set to %d miliseconds.',[thrdDelay]);
Synchronize(CallMainForm);
Sleep(thrdDelay);
FMsg := 'Thread finished.';
Synchronize(CallMainForm);
end;
procedure TWorkerThread.CallMainForm;
begin
ThreadSync.Enter;
Try
If Assigned(FCallBack) Then FCallBack(Format('Thread #%d: %s',[FID,FMsg]));
Finally
ThreadSync.Leave;
End;
end;
initialization
ThreadSync := TCriticalSection.Create;
finalization
ThreadSync.Free;
end.Код:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure ThreadCallBack(Msg : String);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses Unit2;
procedure TMainForm.Button1Click(Sender: TObject);
const
thrdNmb : Integer = 10; // Number of threads to create
var
I : Integer;
Thrd : TWorkerThread;
begin
Memo1.Lines.Clear;
For I := 1 To thrdNmb Do
Begin
Thrd := TWorkerThread.Create(True,ThreadCallBack);
Thrd.FreeOnTerminate := True;
Thrd.Resume;
End;
end;
procedure TMainForm.ThreadCallBack(Msg : String);
begin
Memo1.Lines.Add(Msg);
end;
end.Код проверен в D10.2.3 Berlin. Последний раз редактировалось lmikle, 13.12.2018 в 06:26. |
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Помидоркин (13.12.2018)
| ||
|
#3
|
||||
|
||||
|
Огромное спасибо, в целом все понятно, есть пара вопросов -
Код:
procedure TWorkerThread.Execute;
begin
....
Synchronize(CallMainForm);
end;
procedure TWorkerThread.CallMainForm;
begin
ThreadSync.Enter;
Try
If Assigned(FCallBack) Then FCallBack(Format('Thread #%d: %s',[FID,FMsg]));
Finally
ThreadSync.Leave;
End;
end;Во всех примерах, которые мне попадались, Synchronize и CriticalSection фигурируют как разные способы синхронизации. Код:
procedure TUrlChek.Execute;
begin
....
cntlock.Enter;
trcount:= trcount-1;
cntlock.Leave;
Synchronize(AddGall);
end;
procedure TUrlChek.AddGall;
begin
....
второе: нужно что бы поток проверял наличие папки и при отсутствии создавал ее, не может ли здесь произойти конфликт? И если можно еще два вопроса не совсем по теме: 1. правильно ли я понимаю - в цикле мы создаем потоки Код:
Thrd := WorkerThread.Create(True,ThreadCallBack); Код:
Thrd.FreeOnTerminate := True; // и т.д. 2. в потомке мы перегружаем конструктор Код:
constructor Create(CreateSuspned : Boolean; CallBack : TCallMainFormEvent); Код:
constructor TWorkerThread.Create(CallBack : TCallMainFormEvent); begin FCallBack := CallBack; .... inherited Create(True); end; Последний раз редактировалось Помидоркин, 14.12.2018 в 14:11. |
|
#4
|
|||
|
|||
|
1. потому что Synchronize - это синхронизация с главным потоком. Однако, потоки надо еще между собой синхронизировать. Короче, это не просто так сделано. Если бы был один поток, то CriticalSection не нужна. Т.к. потоков много, то надо их еще между собой синхронизировать.
2. При проверке/создании папки конфликн, конечно, может произойти. Используй критическую секцию. 3. Да, понимаешь правильно. 4. Нет, override там не нужен. В принципе, там лучше указать reintroduce, просто не знаю твою версию Дельфи, так что решил не использовать. 5. Ну, можно и убать параметр, тогда вообще писать конструктор не надо, тогда передавай ссылку на колбэк через свойства. |
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Помидоркин (16.12.2018)
| ||
|
#5
|
||||
|
||||
|
Возникла новая проблема.
Собственно все работает как и должно работать, но... Суть в следующем - потоки запускаются в цикле, их количество может быть несколько тысяч, ограничиваю число одновременно работающих Код:
unit Unit1;
...
var
Form1: TForm1;
ThrdCount: Byte;
implementation
...
procedure TForm1.btnCheckClick(Sender: TObject);
var Checker: TUrlCheckThrd;
Indx: Integer;
begin
for Indx := First to Last do
begin
Checker:= TUrlCheckThrd.Create;
...
Inc(ThrdCount);
while ThrdCount>7 do Sleep(500); //тут окно и зависает
end;
end;Решил создать поток, который будет запускать остальные потоки, так сказать "родительский", эти остальные будут посылать сообщение о своем завершении, Код:
unit MyThread; ..... procedure TUrlCheckThrd.Execute; begin .... Synchronize(CallMainForm); SendMessage(FWND,DEC_THRDCOUNT,0,0); end; Код:
unit MainThread;
..........
type
TMainThread = class(TThread)
private
FThrdCount: Byte;
...........
procedure SetThrdCount(var Msg: TMessage); message DEC_THRDCOUNT;
protected
procedure Execute; override;
.............
end;
implementation
procedure TMainThread.SetThrdCount(var Msg: TMessage);
begin
Dec(FThrdCount);
end;
procedure TMainThread.Execute;
var Checker: TUrlCheckThrd;
Indx: Integer;
begin
for Indx := FFirst to FLast do
begin
Checker:= TUrlCheckThrd.Create(FCallForm, Self.Handle); // дочерний поток получает хэндл родительского
...............
Checker.Start;
Inc(FThrdCount);
while FThrdCount>7 do Sleep(500);
end;
end; |
|
#6
|
|||
|
|||
|
Ну, для начала, поток не может получать стандартные ОКОННЫЕ сообщения, бо как окна то и нету. Вроде есть функция ThreadPostMessage, но я ею никогда не пользовался. Подозреваю, что там еще и поток-получатель надо где-то регистрировать.
Теперь по сути. Изначально неправильная архитектура. Если предполагается, что заданий для обработки может быть много, ОЧЕНЬ МНОГО, то приложение строится немного по другому. Есть такие понятия как очередь заданий и пул потоков. Очередь заданий - синглтон объект (объект, существующий в единственном экземпляре), куда добавляются задания для последуюший ообработки, в твоем случае - урлы. Пул потоков - объект, реализующий управление заданным кол-вом потоков. Как это работает. Главный поток, или несколько других потоков, добавляют в очередь задания (кстати, любая операция с очередью должна быть синхронизированна через CriticalSection). Далее есть некоторый пул потоков (не важно как это реализованно, можно, например, сразу при старте программы запустить десяток потоков, которые просто будут ждать заданий, а можно запускать потоки по мере надобности, но контролировать их кол-во). Каждый поток крутит цикл внутри Execute - проверяем есть ли задания в очереди, если есть - то берем первое и начинаем выполнять, если нет - то засыпаем, например, на 5 сек. Пример кода нада? |
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Помидоркин (19.12.2018)
| ||
|
#7
|
||||
|
||||
|
Повторяется старая история, когда я наколхозил функцию, а потом оказалось что такая функция уже есть и называется она StringReplace
![]() Т.е. вместо того что бы запустить в цикле потоков по количеству заданий, придерживая цикл дабы не превысить кол-во одновременно работающих, в цикле сразу создать все задания и запихать их в список, создать "бригаду" потоков и передать ей список заданий? Цитата:
|
|
#8
|
|||
|
|||
|
Не совсем так.
Пусть будет простой пример. Поток: Код:
type
TWorkerThread = class(TThread)
FTaskQueue : TStringList;
procedure Execute; override;
constructor Create(CreateSuspended : Boolean; TaskQueue : TStringList);
end;
// Критическую секцию перенесли в интерфейс, будем ее использовать
// из главной формы
var
cs : TCriticalSection; // ну как в прошлом примере - надо создать ее
implementation
procedure TWorkerThread.Execute;
var
S : String;
begin
While not Terminated Do
Begin
S := '';
cs.Enter;
Try
If FTaskQueue.Count > 0 Then
Begin
S := FTaskQueue[0];
FTaskQueue.Delete(0);
End;
Finally
cs.Leave;
End;
If S <> ''
Then ProcessUrl(S) // обрабатываем урл, метод не писал...
Else Sleep(1000)
End;
end;
constructor TWorkerThread.Create(CreateSuspended : Boolean; TaskQueue : TStringList);
begin
If not Assigned(TaskQueue)
Then Raise Exception.Create('Не передана очередь заданий.');
inherited Create(CreateSuspended);
FTaskQueue := TaskQueue;
FreeOnTerminate := True;
end;В главной форме. Код:
type
TMainForm = class(TForm)
...
FThreads : Array [1..10] Of TThread;
FTaskQueue : TStringList;
end;
uses
// На создание формы
procedure TMainForm.FormCreate(Sender : TObject);
var
I : Integer;
begin
FTaskThread := TStringList.Create;
For I := Low(FThreads) To High(FThreads) Do
FThreads[i] := TWorkerThread.Create(False,FTaskThread);
end;
// На уничтожение формы, надо удалить потоки
procedure TMainForm.FormDestroy(Sender : TObject);
var
I : Integer;
begin
For I := Low(FThreads) To High(FThreads) Do
Begin
FThreads[i].Terminate;
FThreads[i].WaitFor;
End;
FThreadQueue.Free;
end;
// Где-то добавляется задание. Здесь для примера - по нажатию кнопки
// из Edit1.
procedure TMainForm.Button1Click(Sender : TObject);
begin
cs.Enter; // входим в критическую секцию, которую используют и потоки для синхронизации
Try
FTaskQueue.Add(Edit1.Text);
Finally
cs.Leave;
End;
end;Ну, как-то так. |
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Помидоркин (19.12.2018)
| ||
|
#9
|
||||
|
||||
|
Спасибо.
Кажется почти разобрался Код:
.....
For I := Low(FThreads) To High(FThreads) Do
Begin
FThreads[i].Terminate;
FThreads[i].WaitFor;
End;Код:
procedure TThread.Terminate; begin ... FTerminated := True; .... end; Только надо придумать как передавать задания не строкой, а ну скажем record, или в качестве задания формировать строку с разделителями, а для потока наколхозить функцию, которая эту строку будет разбирать. ...upd... Вроде бы остановился на варианте запихать в TList record-ы, а теперь меня терзают смутные сомнения, не ересь ли я написал пишу по памяти, сам проект остался на работе, в ноуте Код:
unit MyThread; ... type TSomeData = record n1, n2, n3: Integer; m1, m2: Byte; .... Код:
unit Unit1
...
procedur AddToQueue;
var SomeData: TSomeData;
i: Integer;
begin
for i:= 0 to someNamber do
begin
SomeData.n1:= //bla bla bla
SomeData.n2:= //bla bla bla
....
SomeData.m2:= //bla bla bla
List.Add(SomeData);
end;
end;Но даже если этот вопрос будет решен остается другой Изначально планировал наследовать от TThread, скажем так прототип, в который инкапсулирую IdHTTP и прочее, а от него создаю наследников под разные задачи с разными, соответственно наборами данных т.е. с разными record-ами (TSomeData1 = record, TSomeData2 = record и т.д.) В новом варианте усмотрел следующую возможность - ограничится одним наследником, а разные задачи раскидать по разным процедурам Код:
type
TWorkerThread = class(TThread)
......
FMode: TMode
......
end;
..........
implementation
procedure TWorkerThread.Execute;
var
S : String; //вот тут и загвоздка, я заранее не знаю какой из типов у меня будет в листе
begin
While not Terminated Do
Begin
S := '';
cs.Enter;
Try
If FList.Count > 0 Then
Begin
S := FList[0];
FList.Delete(0);
End;
Finally
cs.Leave;
End;
If S <> ''
Then
Case of FMode
mdCheck: ProcessCheck(S);
mdLoad: ProcessLoad(S);
end;
Else Sleep(1000)
End;
end;Я так себе представляю - это нужно из List-а вытащить указатель, независимо от того на какой тип записи он указывает, а в соответствующей процедуре будет объявлена переменная нужного типа и по указателю получаю нужный record. Последний раз редактировалось Помидоркин, 20.12.2018 в 18:26. |
|
#10
|
|||
|
|||
|
Да, написал бред. Именно потому, что там указатели должны быть.
Вообще, я бы рекомендовал не заморачиваться с классическими указателями, а делать классы/объекты. Кстати, для хранения списка объектов есть специальный класс - TObjectList. Там есть еще один моментик - либо надо установить владение итемами в False, либо для получения задания использовать метод Extract. Ну а в случае использования record и TList, должно быть как-то так: Код:
type
TSomeData = record
...
end;
PSomeData = ^TSomeData;
procedure AddToQueue;
var SomeData: PSomeData;
i: Integer;
begin
for i:= 0 to someNamber do
begin
New(SomeData);
SomeData.n1:= //bla bla bla
SomeData.n2:= //bla bla bla
....
SomeData.m2:= //bla bla bla
List.Add(SomeData);
end; |
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Помидоркин (22.12.2018)
| ||
|
#11
|
||||
|
||||
|
Цитата:
|
|
#12
|
|||
|
|||
|
Это относится к варианту с указателями на записи. А уж куда ты будешь складывать их дело десятое.
|
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Помидоркин (23.12.2018)
| ||
|
#13
|
||||
|
||||
|
Опять возникла проблема
В целом все работает, "without debugging" все срабатывает как и должно, но по F9 дебаггер ругается "access violation" на строчку: Synchronize(CallMainForm); Код:
unit DLThrd;
interface
.......
type.
TCallMainFormEvent = procedure (Success: Boolean; Response: string) of object;
TDLThrd = class(TThread)
private
FMode: TDlMode;
FCallBack : TCallMainFormEvent;
FQueue: TObjectList<TObject>;
FData: TObject;
FTaskExist: Boolean;
FDL: TIdHTTP;
FSuccess: Boolean;
FResponse: string;
procedure CallMainForm;
procedure CheckUrlProc(AData: TCheckerData);.
protected
procedure Execute; override;
public
constructor Create(Mode: TDlMode; AQueue: TObjectList<TObject>; CallBack: TCallMainFormEvent);
destructor Destroy; override;
end;
var CS: TCriticalSection;
implementation
constructor TDLThrd.Create(Mode: TDlMode; AQueue: TObjectList<TObject>;CallBack: TCallMainFormEvent);
begin
inherited Create(True);
FreeOnTerminate:= True;
FMode:= Mode;
FQueue:= AQueue;
FCallBack:= CallBack;
FData:= nil;
FTaskExist:= False;
FDL:= TIdHTTP.Create(nil);
FDL.HandleRedirects:= True;
end;
destructor TDLThrd.Destroy;
begin
FDL.Free;
inherited Destroy; end;
procedure TDLThrd.Execute;
begin
while not FTaskExist do //Ожидание задачи
begin
CS.Enter;
try
FTaskExist:= FQueue.Count > 0
finally
CS.Leave;
end;
if not FTaskExist then Sleep(333);
end;
while FTaskExist do //Обработка заданий из очереди
begin
CS.Enter;
try
if FQueue.Count > 0 then
FData:= FQueue.Extract(FQueue.First);
finally
CS.Leave;
end;
FTaskExist:= FData <> nil;
if FTaskExist then
begin
case FMode of
dmCheck: CheckUrlProc(TCheckerData(FData));
//другие варианты обработки
end;
Synchronize(CallMainForm); //Дебаггер ругается
end;
end;
end;
procedure TDLThrd.CallMainForm;
begin
CS.Enter;
try
if Assigned(FCallBack) then FCallBack(FSuccess,FResponse);
finally
CS.Leave;
end;
end;
procedure TDLThrd.CheckUrlProc(AData: TCheckerData);
var i: Integer; url: string;
begin
url:= //задаю url
try
FDL.Head(url);
except on E: Exception do begin FSuccess:= False; FResponse:= E.Message; end;
end;
FSuccess:= (FDL.ResponseCode = 200);
FResponse:= FDL.URL.URI+' - '+FDL.ResponseText;
FreeAndNil(AData);
end;
initialization
CS := TCriticalSection.Create;
finalization
CS.Free;
end.Код:
unit Unit1; ............... //Процедура которая передается потоку в поле FCallBack:TCallMainFormEvent procedure TForm1.WriteResult(Success: Boolean; Response: String); begin ProgressBar1.Position:= ProgressBar1.Position+1; ListBox1.Items.Append(Response); end; |
|
#14
|
|||
|
|||
|
Скорее всего, просто в том момент, когда дебаггер хочет "прицепиться" к этой строчке, тред уже не существует. Как ты думаешь, почему в моем примере внутри execute треда первым идет цикл While not Terminated? В твоем варианте реализации тред просто выполняет задание и завершается (в смысле, когда больше заданий нет), а не ждет когда они появяться. Короче, перемудрил ты, человече. Внимательнее смотри мои примеры.
|
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Помидоркин (04.01.2019)
| ||
|
#15
|
||||
|
||||
|
Цитата:
А с ошибкой вопрос решился, хотя до конца я не понимаю как. Код:
.........
while FTaskExist do //Обработка заданий из очереди
begin
CS.Enter;
try
if FQueue.Count > 0 then
FData:= FQueue.Extract(FQueue.First)
else FTaskExist:= False; // Вместо FTaskExist:= FData <> nil
finally
CS.Leave;
end;
// FTaskExist:= FData <> nil; строку убрал
if FTaskExist then
begin
case FMode of
dmCheck: CheckUrlProc(TCheckerData(FData));
//другие варианты обработки
end;
Synchronize(CallMainForm); //Дебаггер ругается
end;
end;
.............Пока писал вроде бы нашел причину. Второй вариант исправления ошибки и как мне кажется теперь уже правильный. Поверку наличия очередного задания оставляю в старом варианте Код:
FTaskExist:= FData <> nil; Код:
procedure TDLThrd.CheckUrlProc(AData: TCheckerData); begin ......................... // FreeAndNil(AData); FreeAndNil(FData); end; Так что скорее всего дебаггер промахнулся, как это иногда бывает, и ругался он не на Synchronize, а на CheckUrlProc. |