【问题标题】:How to correctly terminate a Thread with Indy HTTP Get command inside?如何使用 Indy HTTP Get 命令正确终止线程?
【发布时间】:2018-04-14 09:17:03
【问题描述】:

我的应用在FormShow 事件上发出GET 命令,有时用户可能会在线程启动但尚未完成后按下Back 并关闭表单,从而导致Thread Error: Invalid argument (22) 或@ 等错误987654325@.

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;

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

【问题讨论】:

  • 尝试不同的策略:在获取完成之前不要让表单关闭。
  • 使用线程安全策略:仅在 Execute 方法中创建和使用 TIdHTTP
  • 您应该认真考虑以下做法:将您的线程写在一个自己的单元中,该单元使用任何表单单元或任何 VCL单位在所有的事情。 VCL 不是线程安全的。从线程中直接访问您的表单非常糟糕 - 这不合逻辑。

标签: android multithreading delphi indy indy10


【解决方案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;

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2014-09-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多