DelphiXE7中如何同步TParallell记录数据

Question

我需要记录一些数据，最好使用线程复制文件，但是通过使用下面的代码，它只会冻结我的应用程序。

如果我正确理解整个 XE7 Parallell 库 TThread.Queue 和 TThread.Synchronize 应该与主线程同步，但在我的情况下整个应用程序冻结。

我做错了什么？

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

如果目标只是在不冻结 UI 线程的情况下复制文件，我会使用这样的东西：

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;

内部任务过程只是像往常一样复制文件，我不确定使用多线程复制是否对您有帮助。

如果您需要与 UI 互动，您需要切换回 UI 线程，您可以使用 TThread.Synchronize.

Answer 2

TParallel.For 执行迭代事件的线程执行，但本身是一种阻塞方法。因此，如果您从主线程启动它，您必须小心同步。

使用 TThread.Queue 是安全的，但正如您已经注意到的，所有排队的事件都在 TParallel.For 完成后处理 - 事实上，在让方法和 return 闲置。

使用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.

已更新

我只是用有关线程和消息发生时间的更多信息扩展日志消息

DelphiXE7中如何同步TParallell记录数据

How to synchronize TParallell in Delphi XE7 to log data

delphi

parallel-processing

multithreading

synchronize