|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Наследник TThread в отдельном модуле
Собственно была программа на 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. |