delphi TIdHTTP线程中的访问冲突

llmtgqce  于 2023-02-15  发布在  其他
关注(0)|答案(1)|浏览(157)

流终止后发生访问冲突,但idHTTP继续满足请求。
下面是线程的构造函数和析构函数:

constructor TTelegramListener.Create(Asyspended: Boolean);
begin
  FFlag := False;
  FreeOnTerminate := True;
  inherited Create(Asyspended);
end;

destructor TTelegramListener.Destroy;
begin
  FCallback := nil;
  inherited;
end;

下面是线程对象的调用和创建:

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;

这是线程被终止的地方:

if Assigned(FMessageListener) then
    FMessageListener.Terminate;

线程本身的代码:

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;

在Status过程中,调用Callback函数:

procedure TTelegramListener.Status;
begin
  if Assigned(FCallback) then
    FCallback(FUserID, FUserName, FUserMessage);
end;

如何修复这段代码,使一切都是线程安全的,并解决异常的问题?
已尝试在销毁线程之前传递的标志上退出while循环。这没有解决问题。已尝试断开

LidHTTP

但那也不管用。

disho6za

disho6za1#

处理完这个问题后,代码的工作方式如下:

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;

感谢大家的回复。一个使用Telegram API的库已经创建,该库支持发送和接收消息,发送文件和地理定位。GitHub项目链接:https://github.com/yaroslav-arkhipov/Telebot_pascal_lib/

相关问题