Multi Thread Delphi

delphi, multithreading

Solution

Here is a threadsafe queue solution using generics.

Define how many consumer threads you want, the queue depth and just run the `DoSomeJob` procedure from a thread.

Define your job working with a string as a generic procedure (in `CaptureJob`).

When the queue is empty, the consumer threads will be destroyed. The `DoSomeJob` procedure waits until all jobs are ready. You can easily turn this into a generic worker pool, reusing the threads without destroying them. The generic structure of the job items also make them suitable to handle different kinds of work.

Note this queue works on XE2 and above. If you are on a older delphi version, look for a similar threadsafe queue as suggested in comments.

uses
  Classes,SyncObjs,Generics.Collections;

Type
  TMyConsumerItem = class(TThread)
  private
    FQueue : TThreadedQueue<TProc>;
    FSignal : TCountDownEvent;
  protected
    procedure Execute; override;
  public
    constructor Create( aQueue : TThreadedQueue<TProc>; aSignal : TCountdownEvent);
  end;

constructor TMyConsumerItem.Create(aQueue: TThreadedQueue<TProc>);
begin
  Inherited Create(false);
  Self.FreeOnTerminate := true;
  FQueue := aQueue;
  FSignal := aSignal;
end;

procedure TMyConsumerItem.Execute;
var
  aProc : TProc;
begin
  try
    repeat
      FQueue.PopItem(aProc);
      if not Assigned(aProc) then
        break; // Drop this thread
      aProc();
    until Terminated;
  finally
    FSignal.Signal;
  end;
end;

procedure DoSomeJob(myListItems : TStringList);
const
  cThreadCount = 10;
  cMyQueueDepth = 100;
var
  i : Integer;
  aQueue : TThreadedQueue<TProc>;
  aCounter : TCountDownEvent;
  function CaptureJob( const aString : string) : TProc;
  begin
    Result :=
      procedure
      begin
        // Do some job with aString
      end;
  end;
begin
  aQueue := TThreadedQueue<TProc>.Create(cMyQueueDepth);
  aCounter := TCountDownEvent.Create(cThreadCount);
  try
    for i := 1 to cThreadCount do
      TMyConsumerItem.Create(aQueue,aCounter);
    for i := 0 to myListItems.Count-1 do begin
      aQueue.PushItem( CaptureJob( myListItems[i]));
    end;
  finally
    for i := 1 to cThreadCount do
      aQueue.PushItem(nil);
    aCounter.WaitFor;  // Wait for threads to finish
    aCounter.Free;
    aQueue.Free;
  end;
end;

NB: Ken explains why your initialization and start of threads are wrong. This proposal shows a better structure to handle this type of problems in a more generic way.

Problem

I'm having problems with multi thread in delphi. I Have a list of names (something about 2.000 names), and I need to get some data of each name in my site. My system works perfectly, except the thread control. I want to create 10 threads, and, when some thread terminate, create another... until end of list. ``` var Form1: TForm; tCount: Integer; //threads count implementation type TCheck = class(TThread) public constructor Create(Name: string); destructor Destroy; Override; protected procedure Execute; Override; end; MainT = class(TThread) protected procedure Execute; Override; end; destructor TCheck.Destroy; begin Dec(tCount); end; procedure MainT.Execute; var i: Integer; Load: TStringList; begin Load:=TStringList.Create; Load.LoadFromFile('C:\mynames.txt'); for i:= 0 to Load.Count -1 do begin if tCount = 10 then //if we have 10 threads running... begin repeat Sleep(1); until tCount < 10; end; TCheck.Create(Load.Strings[i]); TCheck.Start; Inc(tCount); end; end; // end of procedure ``` Well, I didn't put the TCheck.Constructor because the problem is the method how I'm check the number of created threads. I mean, my software just stop, without any error message, sometimes check 500 names, sometimes 150 names... Sorry for Bad English.

Original source

Related problems