Search code examples
delphihttpmemory-leaksindyindy10

Http client get requests


I created an HTTP server with Delphi. To test the server response time I created an http client application which generates random urls. The problem is when I start sending requests to the server part of them are being processed. Here is part of my code:

This procedure is being executed to start sending requests:

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;

This is part of TRequestBuilder class:

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;

**EDIT: ** When I stop the http client I get this error: Access violation at address 004083A0 in module App.exe. Read of address FFFFFFFC.

**EDIT: ** I removed the second for loop in ExecutreURLs and now the program works fine (sometimes the exception is raised). My question now is: is the program leaking memory when I don't terminate the requests in ExecuteURLs procedure?

**EDIT: ** When I remove the repeat- until loop from the Execute procedure the program works fine (only the exception in the first edit is thrown). When I add the repeat- until loop and remove from btnStopQueries onclick event I get several socket errors


Solution

  • Calling TThread.Terminate() merely sets the TThread.Terminated property and does nothing else. It does not actually terminate the thread. A thread is responsible for checking Terminated periodically and then exiting from Execute() when needed. You are not using the Terminated property anywhere in your code, so calling Terminate() is useless in your example.

    You are setting FreeOnTerminate=True in your threads. So no, you are not leaking the threads by not calling Terminate(). They will free themselves after TIdHTTP has finished its work.

    Your Access Violation is most likely due to one or more of the threads simply terminating and freeing themselves from memory before you have a chance to call Terminate() on them. The rule of thumb for using FreeOnTerminate is that if you need to access a thread object from outside of the thread's own code (such as you are doing by tracking the threads and calling Terminate() on them) then DO NOT use FreeOnTerminate=True at all! The TThread object could disappear from memory at ANY moment. Your only saving grace in that situation is if you use the TThread.OnTerminate event to be notified when a FreeOnTerminate thread terminates. That event is fired before the thread frees itself. Otherwise, leave FreeOnTerminate=False and manually free the thread object when you are done using it.

    A safer approach would look more like this instead:

    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;