Access violation in Thread with TIdHTTP - multithreading

Question

An access violation occurs after the stream is terminated, but idHTTP continues to fulfill the request.
Here the constructor and destructor of the thread:
constructor TTelegramListener.Create(Asyspended: Boolean);
begin
FFlag := False;
FreeOnTerminate := True;
inherited Create(Asyspended);
end;
destructor TTelegramListener.Destroy;
begin
FCallback := nil;
inherited;
end;
Here is the call and creation of the thread object:
procedure TTeleBot.StartListenMessages(CallProc: TCallbackProc);
begin
if Assigned(FMessageListener) then
FMessageListener.DoTerminate;
FMessageListener := TTelegramListener.Create(False);
FMessageListener.Priority := tpLowest;
FMessageListener.FreeOnTerminate := True;
FMessageListener.Callback := CallProc;
FMessageListener.TelegramToken := FTelegramToken;
end;
This is where the thread is killed:
if Assigned(FMessageListener) then
FMessageListener.Terminate;
The code for the thread itself:
procedure TTelegramListener.Execute;
var
LidHTTP: TIdHTTP;
LSSLSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
Offset, PrevOffset: Integer;
LJSONParser: TJSONObject;
LResronseList: TStringList;
LArrJSON: TJSONArray;
begin
Offset := 0;
PrevOffset := 0;
//create a local indy http component
try
LidHTTP := TIdHTTP.Create;
LidHTTP.HTTPOptions := LidHTTP.HTTPOptions + [hoNoProtocolErrorException];
LidHTTP.Request.BasicAuthentication := False;
LidHTTP.Request.CharSet := 'utf-8';
LidHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
LSSLSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create(LidHTTP);
LSSLSocketHandler.SSLOptions.Method := sslvTLSv1_2;
LSSLSocketHandler.SSLOptions.SSLVersions := [sslvTLSv1_2];
LSSLSocketHandler.SSLOptions.Mode := sslmUnassigned;
LSSLSocketHandler.SSLOptions.VerifyMode := [];
LSSLSocketHandler.SSLOptions.VerifyDepth := 0;
LidHTTP.IOHandler := LSSLSocketHandler;
LJSONParser := TJSONObject.Create;
LResronseList := TStringList.Create;
except
on E: Exception do
begin
FLastError := 'Error of create objects';
FreeAndNil(LidHTTP);
FreeAndNil(LJSONParser);
FreeAndNil(LResronseList);
end;
end;
try
while not Terminated do
begin
LJSONParser := TJSONObject.Create;
if Assigned(LidHTTP) then
begin
FResponse := LidHTTP.Get(cBaseUrl + FTelegramToken + '/getUpdates?offset=' + IntToStr(Offset) + '&timeout=30');
if FResponse.Trim = '' then
Continue;
LArrJSON := ((TJSONObject.ParseJSONValue(FResponse) as TJSONObject).GetValue('result') as TJSONArray);
if lArrJSON.Count <= 0 then Continue;
LResronseList.Clear;
for var I := 0 to LArrJSON.Count - 1 do
LResronseList.Add(LArrJSON.Items[I].ToJSON);
Offset := LResronseList.Count;
if Offset > PrevOffset then
begin
LJSONParser := TJSONObject.ParseJSONValue(LResronseList[LResronseList.Count - 1], False, True) as TJSONObject;
if (LJSONParser.FindValue('message.text') <> nil) and (LJSONParser.FindValue('message.text').Value.Trim <> '') then
begin
if LJSONParser.FindValue('message.from.id') <> nil then
FUserID := LJSONParser.FindValue('message.from.id').Value; //Его ИД по которому можем ему написать
if LJSONParser.FindValue('message.from.first_name') <> nil then
FUserName := LJSONParser.FindValue('message.from.first_name').Value;
if (LJSONParser.FindValue('message.from.first_name') <> nil) and (LJSONParser.FindValue('message.from.last_name') <> nil) then
FUserName := LJSONParser.FindValue('message.from.first_name').Value + ' ' + LJSONParser.FindValue('message.from.last_name').Value; //Это имя написавшего боту
if LJSONParser.FindValue('message.text') <> nil then
FUserMessage := LJSONParser.FindValue('message.text').Value; //Текст сообщения
Synchronize(Status); // Сообщим что есть ответ
end;
if LJSONParser <> nil then
LJSONParser.Free;
PrevOffset := LResronseList.Count;
end;
end;
end;
finally
FreeAndNil(LidHTTP);
FreeAndNil(LJSONParser);
FreeAndNil(LResronseList);
end;
end;
In the Status procedure, the Callback function is called:
procedure TTelegramListener.Status;
begin
if Assigned(FCallback) then
FCallback(FUserID, FUserName, FUserMessage);
end;
How to fix this code so that everything is thread-safe and solve the problem with the exception?
Tried exiting the while loop on a flag that is passed before destroying the thread. This didn't solve the problem. Tried Disconnecting the
LidHTTP
component, but that didn't work either.

Answer 1

Having dealt with the problem, the code works like this:
procedure TTelegramListener.Execute;
var
LidHTTP: TIdHTTP;
LSSLSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
Offset, PrevOffset: Integer;
LJSONParser: TJSONObject;
LResronseList: TStringList;
LArrJSON: TJSONArray;
begin
Offset := 0;
PrevOffset := 0;
//create a local indy http component
LidHTTP := TIdHTTP.Create;
LidHTTP.HTTPOptions := LidHTTP.HTTPOptions + [hoNoProtocolErrorException];
LidHTTP.Request.BasicAuthentication := False;
LidHTTP.Request.CharSet := 'utf-8';
LidHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
LSSLSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create(LidHTTP);
LSSLSocketHandler.SSLOptions.Method := sslvTLSv1_2;
LSSLSocketHandler.SSLOptions.SSLVersions := [sslvTLSv1_2];
LSSLSocketHandler.SSLOptions.Mode := sslmUnassigned;
LSSLSocketHandler.SSLOptions.VerifyMode := [];
LSSLSocketHandler.SSLOptions.VerifyDepth := 0;
LidHTTP.IOHandler := LSSLSocketHandler;
LJSONParser := TJSONObject.Create;
LResronseList := TStringList.Create;
try
while not Terminated do
begin
if Assigned(LidHTTP) then
begin
FResponse := LidHTTP.Get(cBaseUrl + FTelegramToken + '/getUpdates?offset=' + IntToStr(Offset) + '&timeout=30');
if FResponse.Trim = '' then
Continue;
LArrJSON := ((TJSONObject.ParseJSONValue(FResponse) as TJSONObject).GetValue('result') as TJSONArray);
if lArrJSON.Count <= 0 then Continue;
LResronseList.Clear;
for var I := 0 to LArrJSON.Count - 1 do
LResronseList.Add(LArrJSON.Items[I].ToJSON);
Offset := LResronseList.Count;
if Offset > PrevOffset then
begin
LJSONParser := TJSONObject.ParseJSONValue(LResronseList[LResronseList.Count - 1], False, True) as TJSONObject;
if (LJSONParser.FindValue('message.text') <> nil) and (LJSONParser.FindValue('message.text').Value.Trim <> '') then
begin
if LJSONParser.FindValue('message.from.id') <> nil then
FUserID := LJSONParser.FindValue('message.from.id').Value; //Его ИД по которому можем ему написать
if LJSONParser.FindValue('message.from.first_name') <> nil then
FUserName := LJSONParser.FindValue('message.from.first_name').Value;
if (LJSONParser.FindValue('message.from.first_name') <> nil) and (LJSONParser.FindValue('message.from.last_name') <> nil) then
FUserName := LJSONParser.FindValue('message.from.first_name').Value + ' ' + LJSONParser.FindValue('message.from.last_name').Value; //Это имя написавшего боту
if LJSONParser.FindValue('message.text') <> nil then
FUserMessage := LJSONParser.FindValue('message.text').Value; //Текст сообщения
Synchronize(Status); // Сообщим что есть ответ
end;
PrevOffset := LResronseList.Count;
end;
end;
end;
finally
FreeAndNil(LidHTTP);
FreeAndNil(LJSONParser);
FreeAndNil(LResronseList);
end;
end;
Thanks everyone for the replies. A library for working with the Telegram API has been created, the library supports sending and receiving messages, sending files and geolocation. Link to the GitHub project: https://github.com/yaroslav-arkhipov/Telebot_pascal_lib/