Delphi threads hanging after many executions

Question

I have one multi-thread application that needs to post data via idhttp, to some http hosts... The number of the hosts varies and I put them inside one TXT file that is read into a TStringList. But it's something around 5k hosts daily. Ok, after 3 days running, more or less, and around 15k hosts checked, the threads start hanging at some point of the code, and the program becomes very slow, like it start checking 1 host per 10 minutes... Sometimes it goes far, and stay 1 week running very nicely, but after this same problem: looks like most of the threads start hanging... I don't know where exactly is the problem, because I run it with 100 threads, and like I said, after 15k or more hosts it start becoming slow...

Here's the almost entire source code (sorry to posting entire, but I think it's better more than less)

type
  MyThread = class(TThread)
  strict private
    URL, FormPostData1, FormPostData2: String;
    iData1, iData2: integer;
    procedure TerminateProc(Sender: TObject);
    procedure AddPosted;
    procedure AddStatus;
    function PickAData: bool;
    function CheckHost: bool;
    function DoPostData(const FormPostData1: string; const FormPostData2: string): bool;
  protected
    constructor Create(const HostLine: string);
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  HostsFile, Data1, Data2: TStringList;
  iHost, iThreads, iPanels: integer;
  MyCritical: TCriticalSection;

implementation

function MyThread.CheckHost: bool;
var
  http: TIdHTTP;
  code: string;
begin
  Result:= false;
  http:= TIdHTTP.Create(Nil);
  http.IOHandler:= TIdSSLIOHandlerSocketOpenSSL.Create(http);
  http.Request.UserAgent:= 'Mozilla/5.0 (compatible, MSIE 11, Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko';
  http.HandleRedirects:= True;
  try
    try
      code:= http.Get(URL);
      if(POS('T2ServersForm', code) <> 0) then
        Result:= true;
    except
      Result:= false;
    end;
  finally
    http.Free;
  end;
end;

function MyThread.PickAData: bool;
begin
  Result:= false;
  if (iData2 = Data2.Count) then
    begin
      inc(iData1);
      iData2:= 0;
    end;
  if iData1 < Data1.Count then
    begin
      if iData2 < Data2.Count then
        begin
          FormPostData2:= Data2.Strings[iData2];
          inc(iData2);
        end;
      FormPostData1:= Data1.Strings[iData1];
      Result:= true;
    end;
end;

function MyThread.DoPostData(const FormPostData1: string; const FormPostData2: string): bool;
var
  http: TIdHTTP;
  params: TStringList;
  response: string;
begin
  Result:= false;
  http:= TIdHTTP.Create(Nil);
  http.Request.UserAgent := 'Mozilla/5.0 (compatible, MSIE 11, Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko';
  http.Request.ContentType := 'application/x-www-form-urlencoded';
  params:= TStringList.Create;
  try
    params.Add('LoginType=Explicit');
    params.Add('Medium='+FormPostData1);
    params.Add('High='+FormPostData2);
    try
      response:= http.Post(Copy(URL, 1, POS('?', URL) - 1), params);
      if http.ResponseCode = 200 then
        Result:= true;
    except
      if (http.ResponseCode = 302) then
        begin
          if(POS('Invalid', http.Response.RawHeaders.Values['Location']) = 0) then
            Result:= true;
        end
      else
        Result:= true;
    end;
  finally
    http.Free;
    params.Free;
  end;
end;

procedure MyThread.AddPosted;
begin
  Form1.Memo1.Lines.Add('POSTED: ' + URL + ':' + FormPostData1 + ':' + FormPostData2)
end;

procedure MyThread.AddStatus;
begin
  inc(iPanels);
  Form1.StatusBar1.Panels[1].Text:= 'Hosts Panels: ' + IntToStr(iPanels);
end;

procedure MainControl;
var
  HostLine: string;
begin
  try
    MyCritical.Acquire;
    dec(iThreads);
    while(iHost <= HostsFile.Count - 1) and (iThreads < 100) do
    begin
      HostLine:= HostsFile.Strings[iHost];
      inc(iThreads);
      inc(iHost);
      MyThread.Create(HostLine);
    end;
    Form1.StatusBar1.Panels[0].Text:= 'Hosts Checked: ' + IntToStr(iHost);
    if(iHost = HostsFile.Count - 1) then
    begin
      Form1.Memo1.Lines.Add(#13#10'--------------------------------------------');
      Form1.Memo1.Lines.Add('Finished!!');
    end;
  finally
    MyCritical.Release;
  end;
end;

{$R *.dfm}

constructor MyThread.Create(const HostLine: string);
begin
  inherited Create(false);
  OnTerminate:= TerminateProc;
  URL:= 'http://' + HostLine + '/ServLan/Controller.php?action=WAIT_FOR';
  iData2:= 0;
  iData1:= 0;
end;

procedure MyThread.Execute;
begin
  if(CheckHost = true) then
  begin
    Synchronize(AddStatus);
    while not Terminated and PickAData do
    begin
      try
        if(DoPostData(FormPostData1, FormPostData2)  = true) then
          begin
            iData1:= Data1.Count;
            Synchronize(AddPosted);
          end;
      except
        Terminate;
      end;
    end;
    Terminate;
  end;
end;

procedure MyThread.TerminateProc(Sender: TObject);
begin
  MainControl;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if (FileExists('data2.txt') = false) OR (FileExists('data1.txt') = false) then
    begin
      Button1.Enabled:= false;
      Memo1.Lines.Add('data2.txt / data1.txt not found!!');
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  openDialog : TOpenDialog;
begin
  try
    HostsFile:= TStringList.Create;
    openDialog := TOpenDialog.Create(Nil);
    openDialog.InitialDir := GetCurrentDir;
    openDialog.Options := [ofFileMustExist];
    openDialog.Filter := 'Text File|*.txt';
    if openDialog.Execute then
    begin
     HostsFile.LoadFromFile(openDialog.FileName);
     Button2.Enabled:= true;
     Button1.Enabled:= false;
    end;
  finally
    openDialog.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Button2.Enabled:= false;
  Data1:= TStringList.Create;
  Data1.LoadFromFile('data1.txt');
  Data2:= TStringList.Create;
  Data2.LoadFromFile('data2.txt');
  MyCritical:= TCriticalSection.Create;
  iHost:= 0;
  iThreads:= 0;
  MainControl;
end;

Answer 1

You are constantly creating threads without freeing them. This means that your system will grow out of resources (windows handles, or memory) after a while.

Set FreeOnTerminate := true in the thread constructor to free the thread when terminated.

If you declared ReportMemoryLeaksOnShutdown := true when you started the program in debug mode, this leak would have been reported.

---

MainControl is called from the main thread only and data used there are not accessed from other threads, so there is no need for a critical section.

Using a thread pool will also help to make the application more responsive.

Answer 2

IMO, your thread is getting trapped inside your MyThread.Execute while loop. There is no guarantee that once inside that loop it will exit (because the DoPostData() method depends on some external response). This way, I bet that, one by one, each thread is getting stuck in there until few (or none) remain working.

You should add some log capabilities to your MyThread.Execute() just to be sure that it is not dying somewhere... You can also add a fail safe exit condition there (e.g. if (TriesCount > one zillion times) then exit).

Also, I consider a better design to keep your threads running all the time and just provide new work to them, instead of creating/destroying the threads, i.e. create your 100 threads in the beginning and only destroy them at the end of your program execution. But it requires significant changes to your code.

Answer 3

First, I would trap & log exceptions.

Second, this appears to infinitely build Form1.Memo1. What happens when you run the system out of memory this way? Or exceed it's capacity. (It's been long enough since I've dealt with Delphi, I don't recall if there's a limit in this regard or not. There certainly is if this is 32 bit code.)

Answer 4

Just at a first glance, I'd recommend adding the http := TIdHTTP(Nil) to the TThread.Create event and the http.Free to the Destroy event for TThread. Not sure if that will solve the issue. Windows does have a OS limit on threads per process (can't remember well but the number 63 comes to mind. You may want to create a thread pool to cache your thread requests. It might perform more reliabily with a "thundering herd" of requests. I'm suspecting at that number of requests some of the threads may be terminating abnormally which could slow things down, leak memory, etc. Enabling FullDebugMode and LogMemoryLeakDetailsToFile to check for leaks might reveal something. Checking the task manager to watch the memory used by the running process is another luke warm indicator of a problem; memory usage grows and never releases.

Best of luck.

RP