Delphi Thread try finally?

Question

[Игорь]

Коллеги, добрый день!
Максимально упростил код, для понимания.

Происходят какие-то чудеса.

Смысл достаточно прост.

В цикле обращаемся на сервер.
Парсим, завершаемся.

Но в какой то момент что-то происходит и
ThreadCounter := ThreadCounter - 1;
банально не срабатывает.
И цикл остаётся на вечно заперт

while ThreadCounter >= 2 do
    begin
      Application.ProcessMessages;
      Sleep(100);
    end;

while KWEnum.MoveNext do
  begin

    Thread := TCollectUrlThread.CreateAnonymousThread(
      procedure
      var
        Content: string;
        uri: TURI;
        i: integer;
        KRUrl: TKRUrl;
        KRUrls: TArray<TKRUrl>;
        KRUrlsCollection: TArray<TKRUrl>;
        mce: TMatchCollectionEnumerator;

        this: TCollectUrlThread;
      begin
        this := TThread.Current as TCollectUrlThread;
        try
          // Здесь формирую параметры
          try
            // здесь HTTP запрос

            try
               // здесь парсинг с помощью регулярок
            except
              // могут быть исключения при парсинге
              on E: Exception do
                raise Exception.Create(E.Message);
            end;

            if TRegEx.IsMatch(Content, '\/search\/\?.*?(")', [roSingleLine]) then
            begin
              mce := TRegEx.Matches(Content, '\/search\/\?.*?(")', [roSingleLine]).GetEnumerator;

              while mce.MoveNext do
              begin
                try
                 // Дополнительный запрос по HTTP

                 // Дополнительный парсинг с помощью регулярок

                except
                  on E: Exception do
                    raise Exception.Create(E.Message);
                end;
              end;
            end;

          except
            // Здесь фиксирую общие ошибки.
          end;

          // пишу в базу с помощью FireDAC

        finally
          // ОЧЕНЬ ВАЖНО!
          // ОБЯЗАТЕЛЬНЫЙ ДЕКРИМЕНТ
          ThreadCounter := ThreadCounter - 1; 
        end;
      end);

    // Создаю новый поток
    Inc(ThreadCounter);
    Thread.keyword := KWEnum.Current;
    Thread.project_id := ProjectId;
    Thread.Resume;

    // Ограничитель потоков
    while ThreadCounter >= 2 do
    begin
      Application.ProcessMessages;
      Sleep(100);
    end;
  end;

Comments

[zed]

А проинициализировать счётчик ThreadCounter вы не забыли?

[Игорь]

zedxxx, Нет.
В самом начале процедуры я выставляю его в "0"
Я опустил эту часть кода.

[Игорь]

Такое ощущение, что поток просто умирает, не выполнив секцию в finally

[zed]

Значит проблема в синхронизации. Используйте InterlockedIncrement и InterlockedDecrement для изменения значения счётчика из разных потоков.

[Игорь]

Полная версия

procedure TMainForm.CollectUrl;
var
  KWEnum: TStringsEnumerator;
  Thread: TCollectUrlThread;
  ThreadCounter: Integer;
  ProjectId: Integer;
begin
  try
    if moKeywords.Lines.Text.Length = 0 then
    begin
      raise Exception.Create('Нет не одного ключевого слова, действие отменено!');
    end;

    KWEnum := moKeywords.Lines.GetEnumerator;

    ProjectId := Dm.settings.ReadInteger('CurrentProject', 'id', 0);

    if ProjectId = 0 then
      raise Exception.Create('Проект не существует, действие отменено!');

    Progress.Max := moKeywords.Lines.Count;
    Progress.Visible := true;
    lbStatustext.Text := 'Загрузка контента...';
    while KWEnum.MoveNext do
    begin
      Progress.Value := Progress.Value + 1;
      Thread := TCollectUrlThread.CreateAnonymousThread(
        procedure
        var
          Content: string;
          uri: TURI;
          i: integer;
          KRUrl: TKRUrl;
          KRUrls: TArray<TKRUrl>;
          KRUrlsCollection: TArray<TKRUrl>;
          mce: TMatchCollectionEnumerator;

          this: TCollectUrlThread;
        begin
          this := TThread.Current as TCollectUrlThread;

          TThread.Synchronize(this,
              procedure
              begin
                mNoFindByKeyword.Lines.Add(format('Thread start: %d', [this.ThreadID]));
              end);
          
          try
           // https://site/search/?q=%D0%9A%D1%80%D0%B0%D1%81%D0%BA%D0%B0&how=r
            uri := TURI.Create('https://www.site.ru');
            uri.Path := '/search/';
            uri.AddParameter('q', this.keyword);

            try
              Content := GetContent(uri.ToString);
              KRUrls := ParseUrls(Content);

              try
                for KRUrl in KRUrls do
                begin
                  SetLength(KRUrlsCollection, Length(KRUrlsCollection) + 1);
                  KRUrlsCollection[Length(KRUrlsCollection) - 1].article := KRUrl.article;
                  KRUrlsCollection[Length(KRUrlsCollection) - 1].title := KRUrl.title;
                  KRUrlsCollection[Length(KRUrlsCollection) - 1].url := KRUrl.url;
                  KRUrlsCollection[Length(KRUrlsCollection) - 1].position := 0;
                end;
              except
                on E: Exception do
                  OutputDebugString(PWideChar(E.Message));

              end;

              if TRegEx.IsMatch(Content, '\/search\/\?.*?(")', [roSingleLine]) then
              begin
                mce := TRegEx.Matches(Content, '\/search\/\?.*?(")', [roSingleLine]).GetEnumerator;

                while mce.MoveNext do
                begin
                  try
                    Content := GetContent(Format('https://www.site.ru%s', [mce.Current.Value]));
                    KRUrls := ParseUrls(Content);

                    for KRUrl in KRUrls do
                    begin
                      SetLength(KRUrlsCollection, Length(KRUrlsCollection) + 1);
                      KRUrlsCollection[Length(KRUrlsCollection) - 1].article := KRUrl.article;
                      KRUrlsCollection[Length(KRUrlsCollection) - 1].title := KRUrl.title;
                      KRUrlsCollection[Length(KRUrlsCollection) - 1].url := KRUrl.url;
                      KRUrlsCollection[Length(KRUrlsCollection) - 1].position := 0;
                    end;

                  except
                    on E: Exception do
                      OutputDebugString(PWideChar(E.Message));
                  end;
                end;
              end;

            except
              mNoFindByKeyword.Lines.Add(this.keyword);
            end;

            for i := 0 to length(KRUrlsCollection) - 1 do
              KRUrlsCollection[i].position := i + 1;

            if length(KRUrlsCollection) = 0 then
              mNoFindByKeyword.Lines.Add(this.keyword);

            try
              UrlsPush(this.project_id, KRUrlsCollection, this.keyword);
            except
              on E: Exception do
                OutputDebugString(PWideChar(E.Message));
            end;

          finally
            TThread.Synchronize(this,
              procedure
              begin
                mNoFindByKeyword.Lines.Add(format('Thread end: %d', [this.ThreadID]));
                ThreadCounter := ThreadCounter - 1;
              end);
          end;
        end);

      Inc(ThreadCounter);
      Thread.keyword := KWEnum.Current;
      Thread.project_id := ProjectId;
      Thread.Resume;

      while ThreadCounter >= 1 do
      begin
        Caption := ThreadCounter.ToString;
        Application.ProcessMessages;
        Sleep(300);
      end;
    end;

    while ThreadCounter <> 0 do
    begin
      Application.ProcessMessages;
      Sleep(100);
    end;

  finally
    if Assigned(KWEnum) then
      FreeAndNil(KWEnum);

    Progress.Visible := false;
    Progress.Value := 0;
    lbStatustext.Text := '';
  end;
end;

[zed]

И я по прежнему не вижу строчки ThreadCounter := 0;

[Игорь]

zedxxx, Есть подозрения.

Дело в том, что иногда работает, а иногда просто стопориться.
Как в рулетке.

Не знал о существовании InterlockedDecrement() and InterlockedIncriment();

[zed]

В новых версия Delphi ещё можно использовать System.SyncObjs.TInterlocked

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

[Игорь]

zedxxx, Я тоже )))

[Игорь]

Спасибо, действительно, я вообще не где не поставил ThreadCounter := 0;
Хотя был уверен, что я это сделал, невнимательность.

[Игорь]

Ок, хорошо.
А как тогда быть здесь?

while ThreadCounter >= 3 do
      begin
        Application.ProcessMessages;
        Sleep(300);
      end;

Мы в главном потоке обращаемся к переменной ThreadCounter
Которая может быть заблокирована.

[zed]

TInterlocked.Read() или InterlockedCompareExchange.

[Игорь]

zedxxx, Капец :)

+ в карму

[Игорь]

zedxxx, оформите как ответ.
Я отмечу решением.

[Hemul GM]

Игорь, для синхронизации потоков можно использовать TThread.Synchronize(Self/nil - для текущего, ); в анонимном потоке. При чем ты это даже используешь в своём коде.

[Игорь]

Hemul GM, Да, конечно.
Про синхронизацию мне известно.
Но вот только я был уверен в том что не визуальные компоненты можно делить между потоками.
Хз почему так думал. Но теперь мне понятно, что между потоками без синхронизации делить нечего не нужно.

Я остановился на варианте предложенный zedxxx

Вариант предложенный zedxxx идеально подошёл!
Проблема исчезла, как бабушка пошептала.

[zed]

Игорь, Вообще, Hemul GM дело говорит - раз уж вы обернули в Synchronize работу с разделяемым ресурсом, то дополнительных синхронизаций не требуется, т.к. всё и так будет выполняться в одном потоке и никаких гонок не будет. Соответственно, изначальная ошибка у вас была в том, что вы забыли обнулить счётчик перед использованием (ThreadCounter := 0;), как я и намекнул в самом первом комментарии.

P. S. Ответ оформлять лень, можете ответить самостоятельно.

[Игорь]

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

Да, к компонентам я всегда обращался с Synchronize

Я действительно думал, что к переменным MainThread можно обращаться и потоков.

Но теперь то мы заживём!

[Hemul GM]

Ответ в комментариях к вопросу