如何使用 Indy HTTP Get 命令正确终止线程？

Question

我的应用程序在 FormShow 事件上发出 GET 命令，有时用户可能会在线程启动但尚未完成后按 Back 并关闭表单，导致像 Thread Error: Invalid argument (22) 或 Thread Error: No such process (3).

这样的错误

procedure TForm58.FormShow(Sender: TObject);
begin
    if Assigned(LListThread) then LListThread := nil;
    LListThread := TLoadListThread.Create;
    LListThread.OnTerminate := LoadListThreadTerminated;
    LListThread.Start;
end;

constructor TLoadListThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
end;

procedure TLoadListThread.Execute;
begin
    if Form58.IdHTTP1.Connected then Form58.IdHTTP1.Disconnect;
    st := TStringList.Create;
    try
        ms := TMemoryStream.Create;
        Synchronize(
        procedure
        begin
            Form58.Label1.Text := 'Loading...';
        end);
        try
            Form58.IdHTTP1.Get(urlserver,ms);
            ms.Position := 0;
            st.LoadFromStream(ms, TEncoding.UTF8);
        finally
            ms.Free;
        end;
        // Do something with st
    finally
        st.Free;
    end;
end;

procedure TForm58.LoadListThreadTerminated(Sender: TObject);
begin
    if IdHTTP1.Tag = 1 then
    begin
        LListThread := nil;
        Form58.Close;
    end else
    begin
      LListThread := nil;
      if TThread(Sender).FatalException = nil then
      // Do something
      else
      // Do otherthing
    end;
end;

procedure TForm58.CloseButtonClick(Sender: TObject);
begin
  if Assigned(LListThread) then
  begin
    IdHTTP1.Tag := 1;
    LListThread.Terminate;
  end else Form58.Close;
end;

procedure TForm58.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(LListThread) then
  begin
    LListThread.Destroy;
    LListThread := nil;
  end;
  try
    // Do something
  finally
    Action := TCloseAction.caFree;
  end;
end;

我知道我做的这个线程 start/end 逻辑很糟糕，我该如何改进它并删除显示的错误消息？

Answer 1

当准备关闭窗体时，如果线程仍然运行那么你正在向它发出终止信号，但你没有等待它完全终止，然后你明确地销毁了线程窗体实际关闭时的对象，即使您使用的是 FreeOnTerminate=True。

您应该在显式销毁线程对象之前调用 TThread.WaitFor()，但是在使用 FreeOnTerminate=True 时这不起作用，这会导致您看到的那种错误。除此之外，如果线程仍然是运行，TThread 析构函数会在自身上调用 WaitFor()，并且您正在显式销毁线程对象。所以无论哪种方式，你都会导致错误。

因此，您需要：

设置FreeOnTerminate=False，然后等待线程完全终止后再显式销毁它。
设置FreeOnTerminate=True并且完全不要手动销毁线程对象，在线程终止之前不要关闭Form。

我还建议覆盖线程的虚拟 TerminatedSet() 方法以设置一个标志，然后可以在线程内部检查该标志以中止 GET 请求，例如 TIdHTTP.OnWork事件。

在使用 FreeOnTerminated=True 时尝试这样的操作：

type
  TLoadListThread = class(TThread)
  private
    FUrl: string;
    FOnLoading: TNotifyEvent;
    DoAbort: Boolean;
    procedure CheckAbort;
    procedure DoLoading;
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  protected
    procedure TerminatedSet; override;
  public
    constructor Create(const AUrl: String);
    property OnLoading: TNotifyEvent read FOnLoading write FOnLoading;
  end;

constructor TLoadListThread.Create(const AUrl: String);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FUrl := AUrl;
end;

procedure TLoadListThread.CheckAbort;
begin
  if DoAbort then SysUtils.Abort;
end;

procedure TLoadListThread.DoLoading;
begin
  if Assigned(FOnLoading) then FOnLoading(Self);
end;

procedure TLoadListThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  CheckAbort;
end;

procedure TLoadListThread.TerminatedSet;
begin
  inherited;
  DoAbort := True;
end;

procedure TLoadListThread.Execute;
var
  HTTP: TIdHTTP;
begin
  HTTP := TIdHTTP.Create;
  try
    st := TStringList.Create;
    try
      ms := TMemoryStream.Create;
      try
        if Assigned(FOnLoading) then Synchronize(DoLoading);
        CheckAbort;
        HTTP.Get(FUrl, ms);
        ms.Position := 0;
        st.LoadFromStream(ms, TEncoding.UTF8);
      finally
        ms.Free;
      end;
      CheckAbort;
      // Do something with st
    finally
      st.Free;
    end;
  finally
    HTTP.Free;
  end;
end;

private
  procedure CloseOnTerminated(Sender: TObject);

procedure TForm58.FormShow(Sender: TObject);
begin
  StopLoadListThread;
  LListThread := TLoadListThread.Create(urlserver);
  LListThread.OnLoading := LoadListThreadLoading;
  LListThread.OnTerminate := LoadListThreadFinished;
  LListThread.Start;
end;

procedure TForm58.StopLoadListThread;
begin
  if Assigned(LListThread) then
  begin
    LListThread.OnLoading := nil;
    LListThread.OnTerminate := nil;
    LListThread.Terminate;
    LListThread := nil;
  end;
end;

procedure TForm58.LoadListThreadLoading(Sender: TObject);
begin
  Label1.Text := 'Loading...';
end;

procedure TForm58.LoadListThreadFinished(Sender: TObject);
begin
  if LListThread.FatalException = nil then
    // Do something
  else
    // Do something else

  LListThread := nil;
end;

procedure TForm58.CloseOnTerminated(Sender: TObject);
begin
  LListThread := nil;
  Close;
end;

procedure TForm58.CloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TForm58.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(LListThread) then
  begin
    LListThread.OnTerminate := CloseOnTerminated;
    LListThread.Terminate;
    Action := TCloseAction.caNone;
  end
  else
  begin
    // Do something
    Action := TCloseAction.caFree;
  end;
end;

或者这个，当使用FreeOnTerminated=False时：

type
  TLoadListThread = class(TThread)
  private
    FUrl: string;
    FOnLoading: TNotifyEvent;
    DoAbort: Boolean;
    procedure CheckAbort;
    procedure DoLoading;
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  protected
    procedure TerminatedSet; override;
  public
    constructor Create(const AUrl: String);
    property OnLoading: TNotifyEvent read FOnLoading write FOnLoading;
  end;

constructor TLoadListThread.Create(const AUrl: String);
begin
  inherited Create(True);
  FreeOnTerminate := False;
  FUrl := AUrl;
end;

procedure TLoadListThread.CheckAbort;
begin
  if DoAbort then SysUtils.Abort;
end;

procedure TLoadListThread.DoLoading;
begin
  if Assigned(FOnLoading) then FOnLoading(Self);
end;

procedure TLoadListThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  CheckAbort;
end;

procedure TLoadListThread.TerminatedSet;
begin
  inherited;
  DoAbort := True;
end;

procedure TLoadListThread.Execute;
var
  HTTP: TIdHTTP;
begin
  HTTP := TIdHTTP.Create;
  try
    st := TStringList.Create;
    try
      ms := TMemoryStream.Create;
      try
        if Assigned(FOnLoading) then Synchronize(DoLoading);
        CheckAbort;
        HTTP.Get(FUrl, ms);
        ms.Position := 0;
        st.LoadFromStream(ms, TEncoding.UTF8);
      finally
        ms.Free;
      end;
      CheckAbort;
      // Do something with st
    finally
      st.Free;
    end;
  finally
    HTTP.Free;
  end;
end;

procedure TForm58.FormShow(Sender: TObject);
begin
  StopLoadListThread;
  LListThread := TLoadListThread.Create(urlserver);
  LListThread.OnLoading := LoadListThreadLoading;
  LListThread.OnTerminate := LoadListThreadFinished;
  LListThread.Start;
end;

procedure TForm58.StopLoadListThread;
begin
  if Assigned(LListThread) then
  begin
    LListThread.OnLoading := nil;
    LListThread.OnTerminate := nil;
    LListThread.Terminate;
    LListThread.WaitFor;
    FreeAndNil(LListThread);
  end;
end;

procedure TForm58.LoadListThreadLoading(Sender: TObject);
begin
  Label1.Text := 'Loading...';
end;

procedure TForm58.LoadListThreadFinished(Sender: TObject);
var
  Thread: TThread;
begin
  Thread := TThread(Sender);

  if Thread.FatalException = nil then
    // Do something
  else
    // Do something else

  // if using 10.1 Berlin or earlier:
  TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Queue(nil,
        procedure
        begin
          Thread.Free;
        end
      );
    end;
  ).Start;

  // if using 10.2 Tokyo or later:
  TThread.ForceQueue(nil,
    procedure
    begin
      Thread.Free;
    end
  );
end;

procedure TForm58.CloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TForm58.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  StopLoadListThread;
  // Do something
  Action := TCloseAction.caFree;
end;

如何使用 Indy HTTP Get 命令正确终止线程？

How to correctly terminate a Thread with Indy HTTP Get command inside?

delphi

multithreading

android

indy

indy10