Why my thread keep waiting until Application.ProcessMessages is called? What I'm doing wrong?

Question

I need to run multiples blocks of threads at same time. What Im trying to do is:

A have 197 operation do call individualy on shellExecute

I want to run 4 operations simultanelly

I can only start new operation if I have less then 4 executing

Problems:

I have to insert a lot of Application.ProcessMessages to make it work, and I dont know what Im doing wrong. I tryed everything and nothing seems to work.

Here is the code:

procedure TCompress.NewThread(psArgs: PWideChar);
var
  oThread: TThread;
  nCode : DWord;
begin
  oThread :=  TThread.CreateAnonymousThread(
    procedure
    begin
      try
        FNumberOfThreads := FNumberOfThreads +1; 
        ExecuteAndWait(PChar(FsPathCompressor), psArgs, SW_HIDE, nCode);
        //It is just a CreateProcess with WaitForSingleObject(retorno, INFINITE);
      except on E: Exception do
        begin
          raise;
        end;
      end;
    end);

  oThread.OnTerminate := DoOnTerminate;
  oThread.Start;
end;

procedure TspCompress.DoOnTerminate;
begin
  FNumberOfThreads := FNumberOfThreads -1;
end;

function TspCompress.ExecuteBlocks: Boolean;
var
  sArgs : WideString;
  nBlocksCreated, nTotalBlocks: Integer;
begin  
  nTotalBlocks := 197;
  nBlocksCreated := 0;
  while nBlocksCreated < nTotalBlocks do
  begin
    //Needs Application.ProcessMessages to update FNumberOfThreads.
    while (FNumberOfThreads < 4) and (nBlocksCreated < nTotalBlocks) do
    begin
      try

        sArgs := PChar('C:/file.exe');

        NewThread(PWideChar(sArgs));
        //Needs Application.ProcessMessages to start the thread.
        nBlocksCreated := nBlocksCreated + 1;
      except
      on E: Exception do
        begin
          //Do Something
        end;
      end;
    end;
  end;
end;

FNumberOfThreads is a private variable of the class

This is a sample code of what Im doing. The problem is not with the code it self, but with the Thread concept.

The problem is a general understanding of threads, they don't start/finish synchronously. When your NewThread returns, it's possible that the new thread has already finished. Conversely, it may not have even started executing yet when you increase your block track. — Sertac Akyuz, Oct 25 '19 at 14:57
You need to initialize `nBlocksCreated` to zero before the loop starts — Keith Miller, Oct 25 '19 at 14:58
Also, the exception handling in the thread is pointless. You're just re-raising the exception, which is as good as not catching it at all. You never want an exception to escape a thread. `FNumberOfThreads` is also not protected against concurrent access. — J..., Oct 25 '19 at 15:00
I think overall the strategy you've designed is not workable. You've got a collection of work packages and you're trying to sort of manage spinning off threads within this single synchronous loop. It's not going to work. We can assume (since you haven't shown code) that `FNumberOfThreads` will decrement in `DoOnTerminate`, so naturally that won't happen without pumping messages. You're probably best to throw this out and start again. A managed queue could work, or you could just use a threadpool (depends on what version of Delphi you are using...) — J..., Oct 25 '19 at 15:10
if you want to limit the number of threads, you should do so via a semaphore: http://docwiki.embarcadero.com/Libraries/Rio/en/System.SyncObjs.TSemaphore — A Lombardo, Oct 25 '19 at 15:30
@KeithMiller This is just a sample code. My problem is the thread not being started without application.processMessages — Maico Garden, Oct 25 '19 at 16:24
@J... Thats just a sample, I planned to do some log with the exception and just kill it. — Maico Garden, Oct 25 '19 at 16:24
@ALombardo thats acctually a good ideia, but i dont need (and cannot) block the resource while im running the thread. I mean, think as Im using a DLL in the thread, and it's thread safe, so I can run multiple instances of code calling the DLL (but i want to limmit in 4 everytime). Will this work? Can you do a sample to help me understand? — Maico Garden, Oct 25 '19 at 16:27
@MaicoGarden Your threads are starting and they are running - it's just that `OnTerminate` never gets handled because you are stuck in a loop on the main thread so once your first four threads go you end up stuck since `FNumberOfThreads` never decrements. You need an asynchronous solution. — J..., Oct 25 '19 at 16:36
@J... Actually they are not. I can follow on the TaskManager since the thread creates a shell. In order to make my thread run, I need to call Application.ProcessMessages there where the comments are. OnTerminate is a problem, yes, but thats a second step. lol — Maico Garden, Oct 25 '19 at 16:50
@MaicoGarden Then you're running different code from what you've shown us. The first four threads will *definitely* execute in the code posted in your question. Put a breakpoint in there and watch it get hit. Don't rely on TaskManager - it's usually not showing you what you think it's showing you. — J..., Oct 25 '19 at 16:53
Another problem I see is in `NewThread()`, the data pointed to by `psArgs` can become invalid before the anonymous thread ever has a chance to use it. Don't use a raw pointer for the parameter, use a `String`/`WideString` instead and let the anonymous procedure capture it so it keep the data alive until the thread is finished. — Remy Lebeau, Oct 25 '19 at 18:14
Please be aware you cannot create an unlimited number of threads. So when you need to compress a lot of items, this is not the best way to do this. You'd better create 4 worker threads, which pick up the items to compress, from a specific list. — R. Hoek, Oct 27 '19 at 12:15
See also : [I do not understand what Application.ProcessMessages in Delphi is doing](https://stackoverflow.com/q/25181713/327083) — J..., Oct 27 '19 at 20:05

score 0 · Accepted Answer · answered Oct 31 '19 at 00:12

At the end, I just used System.Threading. Setting a ThreadPool and using Parellel.For.

procedure TCompress.MyParallelProcess;
var
  sArgs : WideString;
  nTotalProcess: Integer;
  oPool: TThreadPool;
  nCode: DWord;
begin
  oPool := TThreadPool.Create;  
  try
    oPool.SetMinWorkerThreads(4);
    oPool.SetMaxWorkerThreads(4);  
    nTotalProcess := 197; 
    TParallel.For(1, nTotalProcess, procedure(i: integer)
    begin
      sArgs := PChar('C:/file'+IntToStr(i)+'.exe');
      ExecuteAndWait(PChar(FsPathCompressor), sArgs, SW_HIDE, nCode);
    end, oPool);
  finally
    FreeAndNil(oPool);
  end;
end;

Remember, this is just a sample code, but i did something like this and works as a glove. Thanks all for your help.

Why my thread keep waiting until Application.ProcessMessages is called? What I'm doing wrong?

1 Answers1