0

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.

Yaroslav
  • 5
  • 4
  • 4
    You have AV because of double free. TIdSSLIOHandlerSocketOpenSSL is created with `LIdHTTP` as owner and it will be destroyed when you free `LIdHTTP`. Remove `FreeAndNil(LSSLSocketHandler)` line. Also you should initialize `LSSLSocketHandler`, `LJSONParser` and `LResronseList` to nil and move your `try` right after line where you construct `LIdHTTP` to properly handle the release if some of the constructors fails for some reason. – Dalija Prasnikar Jan 27 '23 at 09:38
  • Thanks for your reply. The changes you suggested did not help, the error still occurs either in the thread or in the Indy components. – Yaroslav Jan 27 '23 at 10:29
  • 2
    Since there are no answers yet, I suggest editing the question with the new code updated according to Dalija's comments, then marking the related three comments as obsolete – Jan Doggen Jan 27 '23 at 11:19
  • 1
    Your construction is overly complicated now. You don't have to wrap construction in separate try...except block, you can just have everything in single try...finally block, see my answer https://stackoverflow.com/a/42717043/4267244. If you need to handle exception raised in that thread you should have try...except block around all code as now you are just handling it only partially. Or you can inspect thread exception in thread OnTerminate event handler. – Dalija Prasnikar Jan 27 '23 at 13:04
  • 2
    Also what is the purpose of that `while not Terminated do` loop? You are repeating the work you have already done before. Do you expect different data coming in with each request? If you want to continuously fetch data, you should add some kind of waiting period between two requests, instead of flooding the server. – Dalija Prasnikar Jan 27 '23 at 13:08
  • 2
    If the exception is not caused by double free, then you have other issues in your code. Which line causes exception and what is the exact error? – Dalija Prasnikar Jan 27 '23 at 13:18
  • 2
    [Don't pretend to be a different user agent when you don't have all of their features](https://stackoverflow.com/a/40103319/4299358). Most likely you can't even deal with HTTP/2. – AmigoJack Jan 27 '23 at 13:57
  • 1
    You have several memory leaks in your use of `ParseJSONValue()`. You need to `Free` the `TJSONValue` that it returns. You are also not checking if `FindValue()` returns `nil` before accessing the `Value` – Remy Lebeau Jan 27 '23 at 15:59
  • Thanks everyone for the replies. `while not Terminated do`, I expect different results from this, since after the request to the server there may be new messages from users. The error occurs after the program block if Assigned(FMessageListener) then is called FMessageListener.Terminate; which causes the thread to stop and release memory from local objects, but it is possible that LIdHTTP is still making a request to the server during its destruction, this causes an Access violation. I'll fix the UserAgent. Thank you Remy Lebeau i put in the verification code – Yaroslav Jan 29 '23 at 04:57
  • Attached to the first post all the procedures that relate to thread. – Yaroslav Jan 29 '23 at 07:54

1 Answers1

0

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/

Yaroslav
  • 5
  • 4