Коллеги, добрый день!
Максимально упростил код, для понимания.
Происходят какие-то чудеса.
Смысл достаточно прост.
В цикле обращаемся на сервер.
Парсим, завершаемся.
Но в какой то момент что-то происходит и
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;
Средний
