Как синхронизировать TParallell в Delphi XE7 для регистрации данных

Если цель состоит в том, чтобы просто копировать файлы без зависания потока пользовательского интерфейса, я бы просто использовал что-то вроде этого:

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;

Внутри процедуры задачи просто скопируйте файлы, как обычно, я не уверен, поможет ли вам копирование с использованием нескольких потоков.

Если вам нужно взаимодействовать с пользовательским интерфейсом, вам нужно вернуться к потоку пользовательского интерфейса, вы можете использовать TThread.Synchronize.

TParallel.For выполняет потоковое выполнение событий итерации, но сам по себе является блокирующим методом. Так что для этого вам придется быть осторожным с синхронизацией, если вы запускаете это из основного потока.

Использование TThread.Queue работает безопасно, но, как вы уже заметили, все события в очереди обрабатываются после завершения TParallel.For - фактически после выхода из метода и возврата в состояние ожидания.

Использование TThread.Synchronize вызовет взаимную блокировку, если вы используете его в событиях итерации и запускаете TParallel.For из основного потока.

Вот небольшое приложение, показывающее разницу с использованием

• CopyFiles
• ParallelCopyFiles
• AsyncCopyFiles вызывает CopyFiles из задачи
• AsyncParallelCopyFiles вызывает ParallelCopyFiles из задачи

И я предполагаю, что AsyncParallelCopyFiles это тот, кого вы ищете.

Внутри методов Async... безопасно использовать TThread.Synchronize - если вы не ждете задачи внутри основного потока.

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.

ОБНОВЛЕНО

Я просто расширяю сообщение журнала дополнительной информацией о потоке и времени появления сообщения.