流终止后发生访问冲突,但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
但那也不管用。
1条答案
按热度按时间disho6za1#
处理完这个问题后,代码的工作方式如下:
感谢大家的回复。一个使用Telegram API的库已经创建,该库支持发送和接收消息,发送文件和地理定位。GitHub项目链接:https://github.com/yaroslav-arkhipov/Telebot_pascal_lib/