Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Все о Delphi > Программа и интерфейс
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 12.12.2018, 11:42
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию Наследник 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  
Старый 12.12.2018, 20:38
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,502
Версия Delphi: 7, XE3, 10.2
Репутация: 49088
По умолчанию

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

Теперь по синхронизации.
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  
Старый 14.12.2018, 09:49
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Огромное спасибо, в целом все понятно, есть пара вопросов -
Код:
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;
почему FCallBack мы вызываем в критической секции если процедура CallMainForm и так вызывается методом Synchronize.
Во всех примерах, которые мне попадались, 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);
добавляя к нему аргумент (кстати, не должно ли там быть override; как у Execute), а можно ли убрать аргумент?
Код:
constructor TWorkerThread.Create(CallBack : TCallMainFormEvent);
begin
  FCallBack := CallBack;
  ....
  inherited Create(True);
end;

Последний раз редактировалось Помидоркин, 14.12.2018 в 14:11.
Ответить с цитированием
  #4  
Старый 14.12.2018, 22:19
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,502
Версия Delphi: 7, XE3, 10.2
Репутация: 49088
По умолчанию

1. потому что Synchronize - это синхронизация с главным потоком. Однако, потоки надо еще между собой синхронизировать. Короче, это не просто так сделано. Если бы был один поток, то CriticalSection не нужна. Т.к. потоков много, то надо их еще между собой синхронизировать.

2. При проверке/создании папки конфликн, конечно, может произойти. Используй критическую секцию.

3. Да, понимаешь правильно.

4. Нет, override там не нужен. В принципе, там лучше указать reintroduce, просто не знаю твою версию Дельфи, так что решил не использовать.

5. Ну, можно и убать параметр, тогда вообще писать конструктор не надо, тогда передавай ссылку на колбэк через свойства.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Помидоркин (16.12.2018)
  #5  
Старый 18.12.2018, 14:06
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Возникла новая проблема.
Собственно все работает как и должно работать, но...
Суть в следующем - потоки запускаются в цикле, их количество может быть несколько тысяч, ограничиваю число одновременно работающих
Код:
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;
Пинать главную форму Application.ProcessMessages - не вариант, не для того я программу с нуля переписываю.
Решил создать поток, который будет запускать остальные потоки, так сказать "родительский", эти остальные будут посылать сообщение о своем завершении,
Код:
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;
но то что сработало с формой не работает с потоком, то ли поток не слушает сообщения, то ли ждет завершения Execute, во всяком случае FThrdCount не уменьшается.
Ответить с цитированием
  #6  
Старый 18.12.2018, 20:33
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,502
Версия Delphi: 7, XE3, 10.2
Репутация: 49088
По умолчанию

Ну, для начала, поток не может получать стандартные ОКОННЫЕ сообщения, бо как окна то и нету. Вроде есть функция ThreadPostMessage, но я ею никогда не пользовался. Подозреваю, что там еще и поток-получатель надо где-то регистрировать.

Теперь по сути. Изначально неправильная архитектура. Если предполагается, что заданий для обработки может быть много, ОЧЕНЬ МНОГО, то приложение строится немного по другому. Есть такие понятия как очередь заданий и пул потоков.
Очередь заданий - синглтон объект (объект, существующий в единственном экземпляре), куда добавляются задания для последуюший ообработки, в твоем случае - урлы.
Пул потоков - объект, реализующий управление заданным кол-вом потоков.

Как это работает.
Главный поток, или несколько других потоков, добавляют в очередь задания (кстати, любая операция с очередью должна быть синхронизированна через CriticalSection). Далее есть некоторый пул потоков (не важно как это реализованно, можно, например, сразу при старте программы запустить десяток потоков, которые просто будут ждать заданий, а можно запускать потоки по мере надобности, но контролировать их кол-во). Каждый поток крутит цикл внутри Execute - проверяем есть ли задания в очереди, если есть - то берем первое и начинаем выполнять, если нет - то засыпаем, например, на 5 сек.

Пример кода нада?
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Помидоркин (19.12.2018)
  #7  
Старый 19.12.2018, 09:33
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Повторяется старая история, когда я наколхозил функцию, а потом оказалось что такая функция уже есть и называется она StringReplace

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

Цитата:
Пример кода нада?
Да, пожалуйста.
Ответить с цитированием
  #8  
Старый 19.12.2018, 18:37
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,502
Версия Delphi: 7, XE3, 10.2
Репутация: 49088
По умолчанию

Не совсем так.
Пусть будет простой пример.
Поток:
Код:
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  
Старый 20.12.2018, 09:31
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Спасибо.
Кажется почти разобрался
Код:
.....
  For I := Low(FThreads) To High(FThreads) Do
    Begin
      FThreads[i].Terminate;
      FThreads[i].WaitFor;
    End;
У TThread есть некое Boolean свойство, при запуске потока оно установлено в False, в обычном случае по завершении Execute оно устанавливается в True и поток самовыпиливается (при FreeOnTerminate:=True разумеется) ... во! нашел
Код:
procedure TThread.Terminate;
begin
...
  FTerminated := True;
....
end;
В нашем случае мы зацикливаем Execute с помощью Terminated на проверку очереди заданий, а с помощью FThreads[i].Terminate даем возможность выскочить из цикла и завершить Execute. WaitFor - ждем от потока сообщения: "Я кончил, прощайте". Вроде так.

Только надо придумать как передавать задания не строкой, а ну скажем 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;
но TList это список указателей, а я ведь не создаю новый экземпляр TSomeData т.е. я добавляю в лист указатель на одну и ту же переменную.
Но даже если этот вопрос будет решен остается другой
Изначально планировал наследовать от 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;
Вернее так - у меня есть FMode и какой тип записи будет я знаю, но это будет уже в RunTime, а объявить переменную нужно сразу.
Я так себе представляю - это нужно из List-а вытащить указатель, независимо от того на какой тип записи он указывает, а в соответствующей процедуре будет объявлена переменная нужного типа и по указателю получаю нужный record.

Последний раз редактировалось Помидоркин, 20.12.2018 в 18:26.
Ответить с цитированием
  #10  
Старый 20.12.2018, 20:29
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,502
Версия Delphi: 7, XE3, 10.2
Репутация: 49088
По умолчанию

Да, написал бред. Именно потому, что там указатели должны быть.
Вообще, я бы рекомендовал не заморачиваться с классическими указателями, а делать классы/объекты. Кстати, для хранения списка объектов есть специальный класс - 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;
Ну и при удалении не забываем очищать память через Dispose.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Помидоркин (22.12.2018)
  #11  
Старый 22.12.2018, 14:53
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Цитата:
Ну и при удалении не забываем очищать память через Dispose.
Это, надо полагать, относится к варианту с TList?
Ответить с цитированием
  #12  
Старый 22.12.2018, 23:07
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,502
Версия Delphi: 7, XE3, 10.2
Репутация: 49088
По умолчанию

Это относится к варианту с указателями на записи. А уж куда ты будешь складывать их дело десятое.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Помидоркин (23.12.2018)
  #13  
Старый 03.01.2019, 11:41
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Опять возникла проблема
В целом все работает, "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  
Старый 03.01.2019, 19:39
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,502
Версия Delphi: 7, XE3, 10.2
Репутация: 49088
По умолчанию

Скорее всего, просто в том момент, когда дебаггер хочет "прицепиться" к этой строчке, тред уже не существует. Как ты думаешь, почему в моем примере внутри execute треда первым идет цикл While not Terminated? В твоем варианте реализации тред просто выполняет задание и завершается (в смысле, когда больше заданий нет), а не ждет когда они появяться. Короче, перемудрил ты, человече. Внимательнее смотри мои примеры.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Помидоркин (04.01.2019)
  #15  
Старый 04.01.2019, 11:12
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 89
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Цитата:
В твоем варианте реализации тред просто выполняет задание и завершается (в смысле, когда больше заданий нет), а не ждет когда они появятся.
Собственно так и было задумано. Было два варианта: или оставлять потоки крутить цикл while not Terminated, в ожидании новых заданий, либо дать им самовыпилиться, а при необходимости создать их снова.

А с ошибкой вопрос решился, хотя до конца я не понимаю как.
Код:
.........
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;
а вот убивал FData я не правильно
Код:
procedure TDLThrd.CheckUrlProc(AData: TCheckerData);
begin
.........................
 // FreeAndNil(AData);
FreeAndNil(FData);
end;
т.е. FreeAndNil(AData) сам объект может быть и убивал, но значение nil присваивал переменной AData.
Так что скорее всего дебаггер промахнулся, как это иногда бывает, и ругался он не на Synchronize, а на CheckUrlProc.
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 09:17.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2019

ВКонтакте   Facebook   Twitter