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。

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

**编辑：**当我从执行过程中删除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！ {em> ANY 时，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;

Http客户端获取请求

1 个答案: