Http客户端获取请求

Question

我用 Delphi 创建了一个 HTTP 服务器。为了测试服务器响应时间，我创建了一个生成随机 url 的 http 客户端应用程序。问题是当我开始向服务器发送请求时，其中的一部分正在被处理。这是我的代码的一部分：

正在执行此过程以开始发送请求：

procedure TPerformanceTestForm.ExecuteURLs;
var
  requests: array of TRequestBuilder;
  i: Integer;
  Stopwatch: TStopwatch;
  Elapsed: TTimeSpan;
begin
  SetLength(requests, 10);
  EnterCriticalSection(criticalSection);
  Stopwatch := TStopwatch.StartNew;

  for i := 0 to Length(requests) - 1 do
  begin
    requests[i] := TRequestBuilder.Create;
  end;

  // remove this lines from source in order to execute all threads
  // for i := 0 to Length(requests) - 1 do
  // begin
  //   requests[i].Terminate;
  // end;

  Elapsed := Stopwatch.Elapsed;
  Seconds := Elapsed.TotalSeconds;
  LeaveCriticalSection(criticalSection);
end;

procedure TPerformanceTestForm.btnStopQueriesClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Length(requests) - 1 do
  begin
    // requests[i].WaitFor; // the program crashes
    requests[i].Free;
  end;
end;

这是 TRequestBuilder 类的一部分：

TRequestBuilder = class(TThread)
private
  fHttpClient: TIdHTTP;
public
  Constructor Create; reintroduce;
  procedure Execute; override;
end;

Constructor TRequestBuilder.Create;
begin
  inherited Create(False); // in order not to start another loop and call start for each instance
  // FreeOnTerminate := True; // removed this line; see the first answer to know why
  Self.fHttpClient := TIdHTTP.Create;
  // HttpWorkBegin and HttWork I get from the first answer
  Self.fHttpClient.OnWorkBegin := HttpWorkBegin;
  Self.fHttpClient.OnWork := HttpWork; 
end;

procedure TRequestBuilder.Execute;
var
  request, response: string;
begin
  repeat
    try
      request := GenerateHttpRequest;
      response := Self.fHttpClient.Get(request);
      log.AddJob(request + ' ---> ' + response + ' ---> ' +
        FormatDateTime('dd.mm.yyyy hh:mm:ss', Now));
      except
        on e: Exception do
        begin
        errlog.Add(FormatDateTime('dd.mm.yyyy hh:mm:ss', Now) + ' ---> ' +
          e.Message);
        end;
     end;
  until (Terminated);
end;

// EDIT: change Execute procedure to avoid socket errors (removed the httpClient from class variables):
procedure TRequestBuilder.Execute;
var
  request, response: string;
  httpClient: TIdHTTP;
begin
  repeat
    try
      httpClient := TIdHTTP.Create;

      try
        request := GenerateHttpRequest;
        response := httpClient.Get(request);
        log.AddJob(request + ' ---> ' + response + ' ---> ' +
          FormatDateTime('dd.mm.yyyy hh:mm:ss', Now));
      finally
        httpClient.Free;
      end;
    except
      on e: Exception do
      begin
        errlog.Add(FormatDateTime('dd.mm.yyyy hh:mm:ss', Now) + ' ---> ' +
          e.Message);
      end;
    end;
  until (Terminated);
end;

**编辑：** 当我停止 http 客户端时，我收到此错误：模块 App.exe 中地址 004083A0 的访问冲突。读取地址 FFFFFFFC。

**编辑：** 我删除了 ExecutreURLs 中的第二个 for 循环，现在程序运行良好（有时会引发异常）。我现在的问题是：当我不终止 ExecuteURLs 过程中的请求时，程序是否会泄漏内存？

**编辑：** 当我从执行过程中删除重复直到循环时，程序工作正常（仅抛出第一次编辑中的异常）。当我添加重复直到循环并从 btnStopQueries onclick 事件中删除时，我得到了几个套接字错误

Answer 1

调用TThread.Terminate() 只是设置TThread.Terminated 属性，没有做任何其他事情。它实际上并没有终止线程。一个线程负责定期检查Terminated，然后在需要时从Execute() 退出。您没有在代码中的任何位置使用 Terminated 属性，因此在您的示例中调用 Terminate() 是没有用的。

您正在线程中设置FreeOnTerminate=True。所以不，你没有通过不调用Terminate() 来泄漏线程。他们将在TIdHTTP 完成工作后释放自己。

您的访问冲突很可能是由于一个或多个线程在您有机会调用Terminate() 之前简单地终止并从内存中释放自己。使用FreeOnTerminate 的经验法则是，如果您需要从线程自身代码的外部 访问线程对象（例如您正在通过跟踪线程并在它们上调用Terminate() ) 然后不要使用FreeOnTerminate=True！ TThread 对象可能会在 ANY 时刻从内存中消失。在这种情况下，您唯一的优点是如果您使用TThread.OnTerminate 事件在FreeOnTerminate 线程终止时收到通知。该事件在线程释放自身之前被触发。否则，请离开FreeOnTerminate=False，并在使用完线程对象后手动释放它。

一个更安全的方法看起来更像这样：

procedure TPerformanceTestForm.ExecuteURLs;
var
  requests: array of TRequestBuilder;
  i: Integer;
  Stopwatch: TStopwatch;
  Elapsed: TTimeSpan;
begin
  SetLength(requests, 10);
  Stopwatch := TStopwatch.StartNew;

  for i := 0 to Length(requests) - 1 do
  begin
    requests[i] := TRequestBuilder.Create;
  end;

  // optional, maybe after a timeout...
  {
  for i := 0 to Length(requests) - 1 do
  begin
    requests[i].Terminate;
  end;
  }

  for i := 0 to Length(requests) - 1 do
  begin
    requests[i].WaitFor;
    requests[i].Free;
  end;

  Elapsed := Stopwatch.Elapsed;
  Seconds := Elapsed.TotalSeconds;
end;

TRequestBuilder = class(TThread)
private
  fHttpClient: TIdHTTP;
  procedure HttpWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
  procedure HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
protected
  procedure Execute; override;
public
  constructor Create; reintroduce;
  destructor Destroy; override;
end;

constructor TRequestBuilder.Create;
begin
  inherited Create(False);
  fHttpClient := TIdHTTP.Create;
  fHttpClient.OnWorkBegin := HttpWorkBegin;
  fHttpClient.OnWork := HttpWork;
end;

destructor TRequestBuilder.Destroy;
begin
  fHttpClient.Free;
  inherited Destroy;
end;

procedure TRequestBuilder.HttpWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  if Terminated then SysUtils.Abort;
end;

procedure TRequestBuilder.HttpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  if Terminated then SysUtils.Abort;
end;

procedure TRequestBuilder.Execute;
var
  request, response: string;
begin
  request := 'http://localhost/?command=validcommand&param=value';
  response := fHttpClient.Get(request);
  // log source: http://stackoverflow.com/questions/26099961/asynchronous-append-to-txt-file-in-delphi
  log.AddJob(request + ' ---> ' + response);
end;