Cara menyinkronkan TParallell di Delphi XE7 untuk mencatat data

Jika tujuannya hanya untuk menyalin file tanpa membekukan thread UI saya hanya akan menggunakan sesuatu seperti ini:

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;

Di dalam prosedur tugas, cukup salin file seperti biasanya, saya tidak yakin apakah menyalin menggunakan banyak utas akan membantu Anda.

Jika Anda perlu berinteraksi dengan UI, Anda perlu beralih kembali ke thread UI, Anda dapat menggunakan TThread.Synchronize.

TParallel.For melakukan eksekusi thread dari peristiwa iterasi, namun itu sendiri merupakan metode pemblokiran. Jadi untuk ini Anda harus berhati-hati dengan sinkronisasi, jika Anda memulainya dari thread utama.

Penggunaan TThread.Queue bekerja dengan aman tetapi seperti yang sudah Anda ketahui, semua kejadian yang diantri diproses setelah TParallel.For selesai - sebenarnya, setelah keluar dari metode dan kembali ke idle.

Penggunaan TThread.Synchronize akan menyebabkan kebuntuan, jika Anda menggunakannya dalam acara iterasi dan memulai TParallel.For dari thread utama.

Berikut adalah sedikit aplikasi yang menunjukkan perbedaan penggunaannya

• CopyFiles
• ParallelCopyFiles
• AsyncCopyFiles memanggil CopyFiles dari suatu tugas
• AsyncParallelCopyFiles memanggil ParallelCopyFiles dari suatu tugas

Dan saya berasumsi AsyncParallelCopyFiles adalah yang Anda cari.

Dalam metode Async... aman untuk menggunakan TThread.Synchronize - jika Anda tidak menunggu tugas di dalam thread utama.

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.

DIPERBARUI

Saya baru saja menyampaikan pesan log dengan informasi lebih lanjut tentang thread dan waktu terjadinya pesan