Access violation in Thread with TIdHTTP

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/