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

Question

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

Mau*_*ima 1 delphi multithreading android indy indy10

GET我的应用程序对事件发出命令FormShow，有时用户可能会在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;

Run Code Online (Sandbox Code Playgroud)

我知道我制作的这个线程开始/结束逻辑很糟糕，我该如何改进它并删除显示的错误消息？

Answer 1

Rem*_*eau 5

当准备关闭窗体时，如果线程仍在运行，那么您将向其发出终止信号，但您不会等待它完全终止，然后在窗体实际关闭时显式销毁线程对象，即使您正在使用FreeOnTerminate=True。

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

因此，您需要：

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

我还建议重写线程的虚拟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;

Run Code Online (Sandbox Code Playgroud)

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;

Run Code Online (Sandbox Code Playgroud)

或者这样，当使用时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;

Run Code Online (Sandbox Code Playgroud)

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;

Run Code Online (Sandbox Code Playgroud)

归档时间：	8 年，11 月前
查看次数：	560 次
最近记录：	8 年，11 月前