How to synchronize TParallell in Delphi XE7 to log data

Question

I need to log some data and preferrably copy files using a thread, but by using the code below, but it simply freezes my app.

if I understand the whole XE7 Parallell library correctly TThread.Queue and TThread.Synchronize are supposed to sync with the main thread, but in my case the whole app freezes.

What am I doing wrong?

procedure TCopyDeviceContent.StartCopy;
var
  OK: boolean;
begin
  OK := false;

  //  showmessage('fFiles.Count = '+inttostr(fFiles.Count));

  if fFiles.Count = 0 then
  begin
    NotifyDone;
    exit;
  end;

  TParallel.For(0, fFiles.Count-1,
    procedure (Value: Integer)
    begin
      TThread.Queue(TThread.CurrentThread, //Here is where it freezes
        procedure
        begin
          Log('Setting fCurrentFile to '+fFiles.Strings[value]);
        end
      );

      sleep(1000);

      fCurrentFile := fFiles.Strings[value];
      Log('Triggering fOnBeforeProcess');
      if assigned(fOnBeforeProcess) then fOnBeforeProcess(self);

      Log('Does file exist?');
      if FileExists(fFiles.Strings[value]) = true then
      begin
        Log('Yes!');
        Log('Trying to copy file to Windows temp folder.');
        try
          TFile.Copy(fFiles.Strings[value], GetEnvironmentVariable('TEMP'));
        finally
          OK := true;
        end;

        if OK = true then
        begin
          Log('Success!');
          OK := false;

          Log('Does file exist in Windows temp folder?');
          if FileExists(GetEnvironmentVariable('TEMP')+ExtractFileName(fFiles.Strings[value])) then
          begin
            Log('Yes');
            Log('Trying to copy file from Windows temp folder to final destination: '+DestPath+DateToStr(Now)+'\'+ExtractFileName(fFiles.Strings[value]));
            try
              TFile.Move(GetEnvironmentVariable('TEMP')+ExtractFileName(fFiles.Strings[value]),
              DestPath+DateToStr(Now)+'\'+ExtractFileName(fFiles.Strings[value]));
            finally
              fFilesOK.Add(fFiles.Strings[value]);
              Log('Sucess!');
            end;
          end;    
        end
        else
        begin
          fFilesFailed.Add(fFiles.Strings[value]);
          Log('Failed copying to Windows temp folder!');
        end;
      end;
      inc(fProgress);
      NotifyProgress;
      Log('File copy success. Moving on to next file if available...');
    end
  );

  NotifyDone;

  if fFilesFailed.Count > 0 then NotifyError;
end;

Answer 1

TParallel.For performs a threaded execution of the iteration events, but itself is a blocking method. So for this you will have to be careful with the synchronization, if you start this from the main thread.

The use of TThread.Queue works safely but as you already noticed, all the queued events are processed after TParallel.For has finished - in fact, after leaving the method and return to idle.

The use of TThread.Synchronize will cause a dead lock, if you use it in the iteration events and start TParallel.For from the main thread.

Here is a little application showing the difference using

• CopyFiles
• ParallelCopyFiles
• AsyncCopyFiles calls CopyFiles from a task
• AsyncParallelCopyFiles calls ParallelCopyFiles from a task

And I assume AsyncParallelCopyFiles is the one you are looking for.

Within the Async... methods it is safe to use TThread.Synchronize - if you do not wait for task inside the main thread.

unit Form.Main;

interface

uses
  System.IOUtils,
  System.Threading,
  System.Types,

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

---

type
  TLogMsg = record
  private
    FMsg: string;
    FThreadID: Cardinal;
    FOccurred: TDateTime;
  public
    class operator implicit( a: string ): TLogMsg;
    class operator implicit( a: TLogMsg ): string;

    constructor Create( const AMsg: string );
    function ToString: string;

    property Msg: string read FMsg;
    property ThreadID: Cardinal read FThreadID;
    property Occurred: TDateTime read FOccurred;
  end;

---

type
  TForm1 = class( TForm )
    ListBox1: TListBox;
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    procedure Button1Click( Sender: TObject );
  private
    FTask: ITask;
    procedure ThreadSafeLog( ALogMsg: TLogMsg );
  public
    procedure CopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean );
    procedure ParallelCopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean );

    function AsyncCopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean; ACallback: TThreadProcedure ): ITask;
    function AsyncParallelCopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean; ACallback: TThreadProcedure ): ITask;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{ TForm1 }

---

// *** ATTENTION ***
// ParallelCopyFiles will cause a dead lock without USE_QUEUE
// but you still can try yourself ...
//
{$DEFINE USE_QUEUE}
//
// *****************

procedure TForm1.ThreadSafeLog( ALogMsg: TLogMsg );
begin
{$IFDEF USE_QUEUE}
  TThread.Queue
{$ELSE}
  TThread.Synchronize
{$ENDIF}
    ( nil,
      procedure
    begin
      ListBox1.Items.Add( ALogMsg );
    end );
end;

---

procedure TForm1.CopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean );
var
  LSource, LDestination: string;
begin
  ThreadSafeLog( 'CopyFiles - ENTER' );
  for LSource in AFiles do
    begin
      LDestination := TPath.Combine( ADestPath, TPath.GetFileName( LSource ) );
      ThreadSafeLog( 'Copy ' + LSource );
      TFile.Copy( LSource, LDestination, Overwrite );
    end;
  ThreadSafeLog( 'CopyFiles - EXIT' );
end;

---

procedure TForm1.ParallelCopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean );
begin
  ThreadSafeLog( 'ParallelCopyFiles - ENTER' );
  TParallel.&For( Low( AFiles ), High( AFiles ),
    procedure( AIndex: Integer )
    var
      LSource, LDestination: string;
    begin
      LSource := AFiles[AIndex];
      LDestination := TPath.Combine( ADestPath, TPath.GetFileName( LSource ) );
      ThreadSafeLog( 'Copy ' + LSource );
      TFile.Copy( LSource, LDestination, Overwrite );
    end );
  ThreadSafeLog( 'ParallelCopyFiles - EXIT' );
end;

---

function TForm1.AsyncCopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean; ACallback: TThreadProcedure ): ITask;
begin
  ThreadSafeLog( 'AsyncCopyFiles - ENTER' );
  Result := TTask.Run(
    procedure
    begin
      CopyFiles( AFiles, ADestPath, Overwrite );
      TThread.Synchronize( nil, ACallback );
    end );
  ThreadSafeLog( 'AsyncCopyFiles - EXIT' );
end;

---

function TForm1.AsyncParallelCopyFiles( AFiles: TStringDynArray; ADestPath: string; Overwrite: Boolean; ACallback: TThreadProcedure ): ITask;
begin
  ThreadSafeLog( 'AsyncParallelCopyFiles - ENTER' );
  Result := TTask.Run(
    procedure
    begin
      ParallelCopyFiles( AFiles, ADestPath, Overwrite );
      TThread.Synchronize( nil, ACallback );
    end );
  ThreadSafeLog( 'AsyncParallelCopyFiles - EXIT' );
end;

---

procedure TForm1.Button1Click( Sender: TObject );
var
  LFiles: TStringDynArray;
  LDestPath: string;
begin
  ListBox1.Clear; // Clear the log destination

  LFiles := TDirectory.GetFiles( TPath.GetDocumentsPath, '*.*' );
  LDestPath := TPath.Combine( TPath.GetDocumentsPath, '_COPYTEST_' );
  TDirectory.CreateDirectory( LDestPath );

  case RadioGroup1.ItemIndex of
    0:
      CopyFiles( LFiles, LDestPath, True );
    1:
      ParallelCopyFiles( LFiles, LDestPath, True );
    2:
      begin
        Button1.Enabled := False;
        AsyncCopyFiles( LFiles, LDestPath, True,
          procedure
          begin
            Button1.Enabled := True;
          end );
      end;
    3:
      begin
        Button1.Enabled := False;
        AsyncParallelCopyFiles( LFiles, LDestPath, True,
          procedure
          begin
            Button1.Enabled := True;
          end );
      end;
  end;
end;

---

{ TLogMsg }

constructor TLogMsg.Create( const AMsg: string );
begin
  FMsg := AMsg;
  FThreadID := TThread.CurrentThread.ThreadID;
  FOccurred := Now;
end;

class operator TLogMsg.implicit( a: string ): TLogMsg;
begin
  Result := TLogMsg.Create( a );
end;

class operator TLogMsg.implicit( a: TLogMsg ): string;
begin
  Result := a.ToString;
end;

function TLogMsg.ToString: string;
begin
  Result := Format( '$%8.8x [%s] %s', [FThreadID, FormatDateTime( 'hh:nn:ss.zzz', FOccurred ), FMsg] );
end;

end.

---

UPDATED

I just extend the log message with more information about the thread and the occurred time of the message

Answer 2

If goal is just to copy files without freezing UI thread i would just use something like this:

procedure TCopyDeviceContent.StartCopy;
var
 aTask: ITask;
begin
 aTask := TTask.Create (procedure ()
   begin
      // Copy files here  
      TThread.Synchronize(nil,procedure
                  begin
                     //Interact with UI  
                     Form1.Memo1.Lines.Add(‘Begin Execution’);
                  end);
   end);
 aTask.Start;
end;

Inside task procedure just copy files as you would do it usually, i am not sure if copying using multiple threads will help you.

In case you need interact with UI you need to switch back to UI thread, you can use TThread.Synchronize.