Zitat von mm1256:

Zur CriticalSection: Ich hatte die CriticalSection vorher nicht drin, und dann sporadisch Zugriffsverletzungen. Wie schließt man aus, dass mehrere Tasks zur gleichen Zeit im Formular schreiben?

Indem man die Zugriffe synchronisiert mit TThread.Synchronize oder TThread.Queue

Wirf doch einfach mal einen Blick auf den BackgroundWorker. In den Quellen kannst du sehen, wie so etwas gemacht wird.

Eigentlich wäre der BW genau das, was du benötigst ...

Nichts anderes mache ich doch. Also ist die CriticalSection definitiv nicht erforderlich?

Zitat von SirRufo:

Eigentlich wäre der BW genau das, was du benötigst ...

War mir schon klar, dass das noch kommt Ich möchte aber in diesem Fall nicht irgendwelche fertigen Lösungen, sondern eine Anwendung für die eigene Praxis, um Erfahrungen zu gewinnen, wie ich System.Threading effektiv für meine Anwendungen nutzen kann.

Zitat von mm1256:

Ich will ganz einfach mal wissen/testen, was geht, und was nicht

Gerade gesehen: TZipForge.Create(Application);

Ganz üble Geschichte ... denk daran, du befindest dich da nicht im MainThread. Statt Application ganz simpel nil nehmen.

Dann wäre da noch Inc(ThreadCount); aufgerufen aus einem Thread-Kontext, das kann auch lustige Effekte erzielen und du rufst Dec(ThreadCount); nur dann auf, wenn in dem Task eine Exception geworfen wurde ... klingt irgendwie seltsam.

Für ein sicheres Increment/Decrement verwende ganz simpel System.SyncObjs.TInterlocked.Increment bzw. System.SyncObjs.TInterlocked.Decrement. Dafür sind die da

Hallo Sir Rufo,

erst mal vielen Dank für deine Bemühungen.

Die Hilfe bzw. Beschreibung zu

markieren

Code:

System.SyncObjs.TInterlocked.Increment / Decrement

im Wiki ist ja " wahnsinnig ausführlich". Was muss man denn tun, um von selbst auf sowas zu kommen

Zitat:

und du rufst Dec(ThreadCount); nur dann auf, wenn in dem Task eine Exception geworfen wurde ... klingt irgendwie seltsam.

Nicht "seltsam"....das hat schon seine Richtigkeit. Du hast lediglich in ZipperOverallProgress bei der ProgressPhase ppEnd (also wenn der Zipper fertig ist) was überlesen. Ist aber gut versteckt, ich geb's zu.

Weil ich in der Zwischenzeit den Unterschied zwischen TTask und TThread begriffen habe, stelle ich zurzeit auf die klassische Methode mit einem TThread um. Darin feuere ich dann "OnTerminate" und zähle darin ThreadCount runter. So wie es sich (so hoffe ich) eigentlich gehört

Das wird nur dann doof, wenn auf einmal eine Exception auftaucht nachdem du schon heruntergezählt hast.

Darum macht man das immer so

markieren

Delphi-Quellcode:

Inc(foo);
try
  // whatever
finally
  Dec(foo);
end;

Schon kann das gar nicht anders gehen.

Hier mal auf die Schnelle etwas zum Ansschauen

zusammenfalten · markieren

Delphi-Quellcode:

unit dp_186773.Forms.MainForm;

interface

uses
  Threading.ProcQueue,

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

type
  TMainForm = class( TForm )
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click( Sender: TObject );
  private
    FProcQueue: TProcQueue;
    procedure Log( const AMsg: string );
    function CreateProc( const AID: string ): TProc;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.AfterConstruction;
begin
  inherited;
  FProcQueue := TProcQueue.Create( 4 );
end;

procedure TMainForm.BeforeDestruction;
begin
  FProcQueue.Free;
  inherited;
end;

procedure TMainForm.Button1Click( Sender: TObject );
var
  I: Integer;
begin
  for I := 1 to 10 do
    begin
      FProcQueue.Add( CreateProc( TGUID.NewGuid.ToString ) );
    end;
end;

function TMainForm.CreateProc( const AID: string ): TProc;
begin
  Result :=
    procedure
    begin
      TThread.Synchronize( nil,
        procedure
        begin
          Log( AID + ' started' );
        end );
      try
        Sleep( 1000 );
      finally
        TThread.Synchronize( nil,
          procedure
          begin
            Log( AID + ' finished' );
          end );
      end;
    end;
end;

procedure TMainForm.Log( const AMsg: string );
begin
  ListBox1.ItemIndex := ListBox1.Items.Add( AMsg );
end;

end.

zusammenfalten · markieren

Delphi-Quellcode:

unit Threading.ProcQueue;

interface

uses
  System.Generics.Collections,
  System.SysUtils,
  System.Threading;

type
  TProcQueue = class
  private
    FShutdown : Boolean;
    FMaxParallel: Integer;
    FSync : TObject;
    FProcQueue : TQueue<TProc>;
    FTaskList : TList<ITask>;
    procedure Execute( const AProc: TProc );
    procedure TaskHasFinished( const ATask: ITask );
  public
    constructor Create( const MaxParallel: Integer );
    destructor Destroy; override;

    procedure Add( const AProc: TProc );
  end;

implementation

{ TProcQueue }

procedure TProcQueue.Add( const AProc: TProc );
begin
  if FShutdown
  then
    raise EInvalidOpException.Create( 'we are going down' );

  TMonitor.Enter( FSync );
  try
    if FTaskList.Count < FMaxParallel
    then
      Execute( AProc )
    else
      FProcQueue.Enqueue( AProc );
  finally
    TMonitor.Exit( FSync );
  end;
end;

constructor TProcQueue.Create( const MaxParallel: Integer );
begin
  inherited Create;
  FMaxParallel := MaxParallel;
  FSync := TObject.Create;
  FProcQueue := TQueue<TProc>.Create;
  FTaskList := TList<ITask>.Create;
end;

destructor TProcQueue.Destroy;
var
  task: ITask;
begin
  TMonitor.Enter( FSync );
  try
    FShutdown := True;
    FProcQueue.Clear;
  finally
    TMonitor.Exit( FSync );
  end;
  try
    TTask.WaitForAll( FTaskList.ToArray );
  except
    // we do not care about exceptions
  end;
  FTaskList.Free;
  FProcQueue.Free;
  inherited;
  FSync.Free;
end;

procedure TProcQueue.Execute( const AProc: TProc );
var
  task: ITask;
begin
  task := TTask.Create(
    procedure
    begin
      try
        AProc( );
      finally
        TaskHasFinished( task );
      end;
    end );
  FTaskList.Add( task );
  task.Start;
end;

procedure TProcQueue.TaskHasFinished( const ATask: ITask );
begin
  TMonitor.Enter( FSync );
  try
    FTaskList.Remove( ATask );
    if not FShutdown and ( FProcQueue.Count > 0 )
    then
      Execute( FProcQueue.Dequeue( ) );
  finally
    TMonitor.Exit( FSync );
  end;
end;

end.

PS: ITask.Cancel sollte man sich verkneifen

Hallo,

ich habe das Zippen mittlerweile auf TThread umgestellt. Die TTask-Variante ist ja Unsinn für dieses Vorhaben. Es läuft auch weitgehend problemlos. Nur mit der Fortschrittanzeige bei einzelnen Threads hab ich noch etwas Schwierigkeiten. Es funktioniert aber, und somit könnte es auch ein Problem mit ZipForge sein.

Im Lauf des Tages werde ich die aktuelle Version mal posten. Soll es als gezippte Datei sein (pas+dfm)?