CopyDirTree, Timer Events und Threads

[BigBaBallo]

Hallo, bei Nutzung der Komponente CopyDirTree bleiben bei mir sämtliche Timerevents stehen. Angeblich liegt das an der aufwändigen Programmstruktur von CopyDirTree und man bekäme das in den Griff, indem man die Timerevents durch Threads ersetzt.

Das habe ich getan. Die Threads laufen i.O., doch sobald CopyDirTree zuschlägt, bleibt wieder alles stehen.

Nach dem Kopiervorgang laufen alle Nebenjobs normal weiter.

Application.Processmessages kann ich während des Kopiervorganges nicht senden, dazu müsst man in den Quellcode von CopyDirTree rein... (denke ich)

Hat jemand eine Idee? Sollte ich CopyDirtree ebenfalls in einen Thread legen? Derzeit ist das die Hauptroutine.

Ich hätte gern, dass die Uhrzeit innerhalb des aktuellen Fensters mitläuft. Ansonsten entsteht beim Nutzer der Eindruck, dass der Rechner bzw. das Programm hängt. CopyDirTree kommuniziert leider nicht mit der Umgebung, so dass teilweise "Keine Rückmeldung" erscheint. Schlimmstenfalls mit dem Fenster "...reagiert nicht... warten oder abbrechen?" Man sieht aber im Zielordner, dass weiterhin kopiert wird.

Am Rechner kann es nicht liegen, es sind 8 Cores, 16 GB RAM und ne SSD vorhanden. Ich kann normal weiterarbeiten, während mein Programm läuft. Nur innerhalb des Programms verrennt sich irgendwas.

LG!

PS: Kann auf PN nicht antworten, da ich den entsprechenden Button nicht finde oder diese Funktion nicht freigeschaltet wurde. Und nein, ich bin keine KI.

[theo]

Hat jemand eine Idee? Sollte ich CopyDirtree ebenfalls in einen Thread legen? Derzeit ist das die Hauptroutine.

Nicht ebenfalls, sondern nur. CopyDirtree ist ja der blockierende Teil.
Die Timer gehören in den Hauptthread.

Alternativ den CopyDirtree Code aufdröseln und dort z.B. OnFileFound (geerbt von TFileSearcher) mit Application.Processmessages versehen.

Es gibt auch externen Code um Verzeichnisse zu kopieren. z.B.
https://github.com/Alexey-T/CopyDir-Laz ... opydir.pas

EDIT: Hier noch ein Beispiel, was ich mit "aufdröseln" meine.
So kannst du ein Application.ProcessMessages einfügen, oder den aktuell kopierten Dateinamen ausgeben etc.

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  StrUtils, LazUTF8, FileUtil, LazFileUtils;

type

  TMyCopyDirTree = class(TFileSearcher)
  private
    FCopyEmptyDirectories: boolean;
    FSourceDir: string;
    FTargetDir: string;
    FFlags: TCopyFileFlags;
    FCopyFailedCount: integer;
  protected
    procedure DoFileFound; override;
    procedure DoDirectoryFound; override;
  public
    property CopyEmptyDirectories: boolean read FCopyEmptyDirectories
      write FCopyEmptyDirectories default False;
    constructor Create; override;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TMyCopyDirTree.DoFileFound;
var
  NewLoc: string;
begin
  //Writeln(FileName);
  Application.ProcessMessages;  //++++++++++ NEU ++++++++++
  // ToDo: make sure StringReplace works in all situations !
  NewLoc := StringReplace(FileName, FSourceDir, FTargetDir, []);
  if not CopyFile(FileName, NewLoc, FFlags) then
    Inc(FCopyFailedCount);
end;

procedure TMyCopyDirTree.DoDirectoryFound;
var
  NewDir: string;
begin
  // Directory is only created by the cffCreateDestDirectory flag if there actually is a file to copy
  // if the directory has no files in it, it will by default not be created in the target directory: issue #41883
  NewDir := StringReplace(FileName, FSourceDir, FTargetDir, []);
  if (cffCreateDestDirectory in FFlags) and FCopyEmptyDirectories and
    (not DirectoryExistsUTF8(NewDir)) and (not ForceDirectoriesUTF8(NewDir)) then
    Inc(FCopyFailedCount);
end;

constructor TMyCopyDirTree.Create;
begin
  inherited Create;
  FCopyEmptyDirectories := False;
end;

function MyCopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags;
  CopyEmptyDirs: boolean): boolean;
var
  Searcher: TMyCopyDirTree;
begin
  Result := False;
  Searcher := TMyCopyDirTree.Create;
  try
    // Destination directories are always created. User setting has no effect!
    Searcher.FFlags := Flags + [cffCreateDestDirectory];
    Searcher.FCopyFailedCount := 0;
    Searcher.FSourceDir := TrimFilename(SetDirSeparators(SourceDir));
    Searcher.FTargetDir := TrimFilename(SetDirSeparators(TargetDir));
    Searcher.CopyEmptyDirectories := CopyEmptyDirs;

    // Don't even try to copy to a subdirectory of SourceDir.
    //append a pathedelim, otherwise CopyDirTree('/home/user/foo','/home/user/foobar') will fail at this point. Issue #0038644
    {$ifdef CaseInsensitiveFilenames}
     if AnsiStartsText(AppendPathDelim(Searcher.FSourceDir), AppendPathDelim(Searcher.FTargetDir)) then Exit;
    {$ELSE}
    if AnsiStartsStr(AppendPathDelim(Searcher.FSourceDir),
      AppendPathDelim(Searcher.FTargetDir)) then Exit;
    {$ENDIF}
    Searcher.Search(SourceDir);
    Result := Searcher.FCopyFailedCount = 0;
  finally
    Searcher.Free;
  end;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyCopyDirTree('/home/ich/Downloads/x1/', '/home/ich/Downloads/x2/',
    [cffCreateDestDirectory], False);
end;

end.      

[BigBaBallo]

Danke, als erstes werde ich am Montag testen, ob es was bringt, wenn der Kopierprozess im Thread läuft.

Melde mich wieder.

LG und schönes Wochenende.

[Socke]

Danke, als erstes werde ich am Montag testen, ob es was bringt, wenn der Kopierprozess im Thread läuft.

Der von theo verlinkte Code hat auf den ersten Blick keine Abhängigkeiten zur LCL. Daher ist das wohl die einfachste Variante. Wenn du das Logging irgendwie in dein Programm ausgibst, muss das dann selbstverständlich absichern.