delphi - 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 过程中的请求时，程序是否会泄漏内存？

**编辑:** 当我从 Execute 过程中删除 repeat- until 循环时，程序运行正常(仅抛出第一次编辑中的异常)。当我添加 repeat- until 循环并从 btnStopQueries onclick 事件中删除时，我得到了几个套接字错误

Answer 1

调用 TThread.Terminate() 仅设置 TThread.Terminated 属性，不执行任何其他操作。它实际上并不终止线程。线程负责定期检查Terminated，然后在需要时退出Execute()。您没有在代码中的任何地方使用 Terminated 属性，因此在您的示例中调用 Terminate() 是无用的。

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

您的访问冲突很可能是由于一个或多个线程在您有机会对其调用 Terminate() 之前简单地终止并从内存中释放它们。使用 FreeOnTerminate 的经验法则是，如果您需要从线程自身代码的外部访问线程对象(例如您通过跟踪线程和调用Terminate() )然后不要使用FreeOnTerminate=True! TThread 对象可能会在任何 时刻从内存中消失。在这种情况下，唯一的可取之处是使用 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;