CopyFile lässt die Anwendung hängen, wie umgehen?

[mkinzler]

Zitat:

Zitat von AlexII (Beitrag 1304045)

Zitat:

Zitat von mm1256 (Beitrag 1304039)

Zitat:

Zitat von AlexII (Beitrag 1304009)

....oder gibt's da auch andere Möglichkeiten?

Und ab und zu mal ein Application.ProcessMessages würde nichts einfrieren lassen.

Ok... was macht eigentlich

Delphi-Quellcode:

Application.ProcessMessages

und in wiefern lässt es die Anwendung nicht einfrieren?

Gibt Rechenzeit ab, in der Hoffung, das diese durch die UI für eine Aktualisierung genutzt wird.

[AlexII]

Zitat:

Zitat von mkinzler (Beitrag 1304049)

Zitat:

Zitat von AlexII (Beitrag 1304045)

Zitat:

Zitat von mm1256 (Beitrag 1304039)

Zitat:

Zitat von AlexII (Beitrag 1304009)

....oder gibt's da auch andere Möglichkeiten?

Und ab und zu mal ein Application.ProcessMessages würde nichts einfrieren lassen.

Ok... was macht eigentlich

Delphi-Quellcode:

Application.ProcessMessages

und in wiefern lässt es die Anwendung nicht einfrieren?

Gibt Rechenzeit ab, in der Hoffung, das diese durch die UI für eine Aktualisierung genutzt wird.

Dann kann ich praktisch nen Timer setzen und da jede 10 Sekunden

Delphi-Quellcode:

Application.ProcessMessages

aufrufen? Ok, muss ma ausprobieren.

[mkinzler]

Es gibt aber keine Gewähr, dass das richti funktioniert. Besser ist es die Arbeit in einen Hintergrundprozess auzulagern. Der Hauptthread kümmert sich dann nur um die Anzeige des Fortschritts.

[himitsu]

Zitat:

Zitat von AlexII (Beitrag 1304050)

Dann kann ich praktisch nen Timer setzen und da jede 10 Sekunden

Delphi-Quellcode:

Application.ProcessMessages

aufrufen? Ok, muss ma ausprobieren.

Natürlich nicht.

Application.ProcessMessages verarbeitet "jetzt" anstehende Messages in der Message-Queue des Hauptthreads, was so in etwa ganz bestimmt auch in der Hilfe erklärt wird.
Und da Timer-Ereignisse ja bekanntlich über eine Message ausgelöst werden...

[BadenPower]

Zitat:

Zitat von AlexII (Beitrag 1304035)

Ja, Lazarus macht da nicht mit... :(

Dann deklariere die API-Funktion in Lazarus doch selbst.

Code:

function CopyFileEx(lpExistingFileName, lpNewFileName: PChar;
    lpProgressRoutine: Pointer; lpData: Pointer; pbCancel: PBool;
    dwCopyFlags: DWORD): WINBOOL; external 'kernel32' name 'FileCopyExA';

Achtung:
Parameter nicht überprüft.
Eventuell auch noch für 'FileCopyExW' erstellen

[Mavarik]

Zitat:

Zitat von AlexII (Beitrag 1304050)

Dann kann ich praktisch nen Timer setzen und da jede 10 Sekunden

Delphi-Quellcode:

Application.ProcessMessages

aufrufen? Ok, muss ma ausprobieren.

Autsch... Nein...

Warum willst Du den keinen Thread nehmen... Ich überlege jeden Tag: "Kann ich diese 3 Zeilen im Thread ausführen?" Und wenn es dann endlich mal etwas ist, was nicht im Hauptthread laufen muss, freue ich mich ein Schneekönig.

Mavarik

[AlexII]

Zitat:

Zitat von Mavarik (Beitrag 1304071)

Zitat:

Zitat von AlexII (Beitrag 1304050)

Dann kann ich praktisch nen Timer setzen und da jede 10 Sekunden

Delphi-Quellcode:

Application.ProcessMessages

aufrufen? Ok, muss ma ausprobieren.

Autsch... Nein...

Warum willst Du den keinen Thread nehmen... Ich überlege jeden Tag: "Kann ich diese 3 Zeilen im Thread ausführen?" Und wenn es dann endlich mal etwas ist, was nicht im Hauptthread laufen muss, freue ich mich ein Schneekönig.

Mavarik

Ich habe einfach noch nie mit Threads gearbeitet... aber muss wohl jetzt.

[mm1256]

Zitat:

Zitat von AlexII

Ich habe einfach noch nie mit Threads gearbeitet... aber muss wohl jetzt.

Mir geht es ähnlich. Wenn es vermeidbar ist mit Threads zu arbeiten, dann tue ich es. Aber wahrscheinlich ist es wie Radfahren lernen.

Ich hab eine Routine zum Files kopieren, die würde ich auch gerne ab und zu mal in einen Thread packen. Das Problem - aus meiner Sicht - ist die Synchronisation des ProgressBar im Formular. So sieht es momentan aus:

Delphi-Quellcode:

...
type
  TFileCopyMode = (fomAlways, fomIfNewer, fomIfOlder, fomIfSameDate, fomIfSameDateTime);
  TFileCopyCallback  = procedure(ProgressValue: Integer) of object;

...

function MyCopyFile(SourceName, DestName: string;
                    FileCopyMode: TFileCopyMode;
                    Progress: TFileCopyCallback): string;
var
  BytesRead, BytesToRead, P, Percent: Int64;
  SourceStream, DestStream: TFileStream;
  SourceDateTime, DestDateTime: TDateTime;
begin
  Result := '';
  if not FileExists(SourceName) then Exit('Quelldatei <'+SourceName+'> existiert nicht');
  if not FileAge(SourceName, SourceDateTime) then Exit('Quelldatei: TimeStamp lesen fehlgeschlagen');
  BytesRead := 0;
  Percent := 0;
  P := 0;
  // DestName darf auch ein Directory sein...dann den Dateinamen ran hängen
  if DirectoryExists(DestName) // DestName ist ein Directory
  then DestName := IncludeTrailingBackslash(DestName)+ExtractFileName(SourceName);
  if FileExists(DestName) then begin
    if not FileAge(DestName, DestDateTime) then Exit('Zieldatei: TimeStamp lesen fehlgeschlagen');
    case FileCopyMode of
      fomAlways         :;// immer kopieren
      fomIfNewer        : // Die Quelldatei muss neuer als die Zieldatei sein
                          if NOT (SourceDateTime > DestDateTime)
                          then Exit('Die Quelldatei ist nicht neuer als die Zieldatei');
      fomIfOlder        : // Die Quelldatei muss älter als die Zieldatei sein => z.B. Downgrade
                          if NOT (SourceDateTime < DestDateTime)
                          then Exit('Die Quelldatei ist nicht älter als die Zieldatei');
      fomIfSameDate     : // Quell- und Ziel-Datei müssen am selben Tag erstellt worden sein
                          if Trunc(DestDateTime) <> Trunc(SourceDateTime)
                          then Exit('Die Zieldatei ist nicht vom selben Datum als die Quelldatei');
      fomIfSameDateTime : // Das Datum von Quell- und Ziel-Datei muss identisch sein
                          if DestDateTime <> SourceDateTime
                          then Exit('Datum und Zeit von Zieldatei und Quelldatei sind unterschiedlich');
      else raise Exception.Create('Da hat der Programmierer was vergessen');
    end;
  end;
  SourceStream := TFileStream.Create(SourceName,fmOpenRead or fmShareDenyNone);
  DestStream := TFileStream.Create(DestName,fmCreate);
  try
    if @Progress = nil
    then DestStream.CopyFrom(SourceStream,SourceStream.Size) // so geht es am schnellsten
    else begin // mit Fortschrittanzeige
      Progress(0);
      BytesToRead := SizeOf(StreamCopyBuffer);
      if SourceStream.Size < BytesToRead then BytesToRead := SourceStream.Size;
      repeat
        SourceStream.ReadBuffer(StreamCopyBuffer,BytesToRead);
        DestStream.WriteBuffer(StreamCopyBuffer,BytesToRead);
        BytesRead := BytesRead + BytesToRead;
        Percent := (BytesRead * 100) div SourceStream.Size;
        if P <> Percent then begin
          Progress(Integer(Percent));
          P := Percent;
        end;
        if (SourceStream.Size - BytesRead) <= BytesToRead
        then BytesToRead := SourceStream.Size - BytesRead;
      until BytesRead >= SourceStream.Size;
      if BytesRead <> SourceStream.SIZE
      then Result := 'Fehler beim Kopiervorgang:'+#13#10
                     +'Bytes gelesen:' + IntToStr(BytesRead) + #13#10
                     +'Bytes geschrieben:' + IntToStr(SourceStream.SIZE)
      else Progress(100);
    end;
  finally
    SourceStream.Free;
    DestStream.Free;
  end;
  if Result = ''
  then MySetAllFileDates(DestName, SourceDateTime, SourceDateTime, SourceDateTime);
end;

Womit dem TE ja auch geholfen wäre ist die Frage: Wie packt man das in einen Thread?

[BUG]

Zitat:

Zitat von mm1256 (Beitrag 1304148)

Das Problem - aus meiner Sicht - ist die Synchronisation des ProgressBar im Formular.

Mit dem synchronize von TThread ist alles Komplizierte (Aufruf von Methoden im Mainthread über Windows Messages) im Prinzip schon weggekapselt und deine Funktion kann man dank dem Callback auch einfach so verwenden.

Du leitest von TThread ab und rufst dort in execute die Funktion auf. Das Callback ist dabei eine Methode in deiner Thread-Klasse, die das eigentliche Callback (zum Beispiel das Updaten der Progressbar) synchronisiert, dh. im Mainthread, aufruft. Die Parameter für die Funktion kannst du dem Thread im Konstruktor übergeben (der wird noch synchron im Mainthread ausgeführt), für die Rückgabewerte und Exceptions musst du dir noch was überlegen. Ein weiteres synchronisiertes Callback würde sich dafür anbieten.

[mm1256]

Hallo Robert,

danke für den Tipp. Hab's einfach mal probiert....und langsam verliere ich auch die Angst vor den Threads. Weil, es scheint auf Anhieb zu funktionieren.

Für den TE:

Delphi-Quellcode:

unit RuFileCopy;

interface

uses
  System.Classes;

type

  TFileCopyMode = (fomAlways, fomIfNewer, fomIfOlder, fomIfSameDate, fomIfSameDateTime);
  TFileCopyCallback  = procedure(ProgressPercent: Integer) of object;

  TRuFileCopyThread = class(TThread)
  private
    { Private-Deklarationen }
    FCopyResult, FSourceName, FDestName: string;
    FFileCopyMode: TFileCopyMode;
    FFileCopyCallback: TFileCopyCallback;
    procedure ThreadCopyCallback(ProgressPercent: Integer);
  protected
    procedure Execute; override;
  public
    constructor Create(aSourceName, aDestName: string;
                       aFileCopyMode: TFileCopyMode;
                       aFileCopyCallback: TFileCopyCallback);
    procedure ThreadIsReady(Sender: TObject);
  end;

const
  cRuFileCopyReady = 200;

var
  RuFileCopyThreadResult: string = '';

{- Eine Datei kopieren: Direkt-Aufruf -}
function RuFileCopyExecute(aSourceName, aDestName: string;
                           aFileCopyMode: TFileCopyMode;
                           aFileCopyCallback: TFileCopyCallback): string;

{- Eine Datei kopieren: Kopiert die Datei in einem eigenen Thread -}
function RuFileCopyThread(aSourceName, aDestName: string;
                          aFileCopyMode: TFileCopyMode;
                          aFileCopyCallback: TFileCopyCallback): string;

implementation

uses System.SysUtils;

var
  StreamCopyBuffer: array[0..500 * 1024] of byte;
  ProgressPercent: Int64;

{------------------------------------------------------------------------------}
{- Eine Datei kopieren: Direkt-Aufruf oder Aufruf aus dem Thread              -}
{- aSourceName = Name der Quelldatei                                          -}
{- aDestName = Name der ZielDatei, darf auch das Zielverzeichnis sein         -}
{- aFileCopyCallback = ProgressCallback: Übergibt Wert in Prozent von 1-100   -}
{------------------------------------------------------------------------------}
function RuFileCopyExecute(aSourceName, aDestName: string;
                           aFileCopyMode: TFileCopyMode;
                           aFileCopyCallback: TFileCopyCallback): string;
var
  BytesRead, BytesToRead, P: Int64;
  SourceStream, DestStream: TFileStream;
  SourceDateTime, DestDateTime: TDateTime;
begin
  Result := '';
  if not FileExists(aSourceName) then Exit('Quelldatei <'+aSourceName+'> existiert nicht');
  if not FileAge(aSourceName, SourceDateTime) then Exit('Quelldatei: TimeStamp lesen fehlgeschlagen');
  BytesRead := 0;
  ProgressPercent := 0;
  P := 0;
  // DestName darf auch ein Directory sein...dann den Dateinamen ran hängen
  if DirectoryExists(aDestName) // DestName ist ein Directory
  then aDestName := IncludeTrailingBackslash(aDestName)+ExtractFileName(aSourceName);
  if FileExists(aDestName) then begin
    if not FileAge(aDestName, DestDateTime) then Exit('Zieldatei: TimeStamp lesen fehlgeschlagen');
    case aFileCopyMode of
      fomAlways         :;// immer kopieren
      fomIfNewer        : // Die Quelldatei muss neuer als die Zieldatei sein
                          if NOT (SourceDateTime > DestDateTime)
                          then Exit('Die Quelldatei ist nicht neuer als die Zieldatei');
      fomIfOlder        : // Die Quelldatei muss älter als die Zieldatei sein => z.B. Downgrade
                          if NOT (SourceDateTime < DestDateTime)
                          then Exit('Die Quelldatei ist nicht älter als die Zieldatei');
      fomIfSameDate     : // Quell- und Ziel-Datei müssen am selben Tag erstellt worden sein
                          if Trunc(DestDateTime) <> Trunc(SourceDateTime)
                          then Exit('Die Zieldatei ist nicht vom selben Datum als die Quelldatei');
      fomIfSameDateTime : // Das Datum von Quell- und Ziel-Datei muss identisch sein
                          if DestDateTime <> SourceDateTime
                          then Exit('Datum und Zeit von Zieldatei und Quelldatei sind unterschiedlich');
      else raise Exception.Create('Da hat der Programmierer was vergessen');
    end;
  end;
  SourceStream := TFileStream.Create(aSourceName,fmOpenRead or fmShareDenyNone);
  DestStream := TFileStream.Create(aDestName,fmCreate);
  try
    if @aFileCopyCallback = nil
    then DestStream.CopyFrom(SourceStream,SourceStream.Size) // so geht es am schnellsten
    else begin // mit Fortschrittanzeige
      aFileCopyCallback(0);
      BytesToRead := SizeOf(StreamCopyBuffer);
      if SourceStream.Size < BytesToRead then BytesToRead := SourceStream.Size;
      repeat
        SourceStream.ReadBuffer(StreamCopyBuffer,BytesToRead);
        DestStream.WriteBuffer(StreamCopyBuffer,BytesToRead);
        BytesRead := BytesRead + BytesToRead;
        ProgressPercent := (BytesRead * 100) div SourceStream.Size;
        if P <> ProgressPercent then begin
          aFileCopyCallback(Integer(ProgressPercent));
          P := ProgressPercent;
        end;
        if (SourceStream.Size - BytesRead) <= BytesToRead
        then BytesToRead := SourceStream.Size - BytesRead;
      until BytesRead >= SourceStream.Size;
      if BytesRead <> SourceStream.SIZE
      then Result := 'Fehler beim Kopiervorgang:'+#13#10
                     +'Bytes gelesen:' + IntToStr(BytesRead) + #13#10
                     +'Bytes geschrieben:' + IntToStr(SourceStream.SIZE)
      else aFileCopyCallback(100); // Kopiervorgang 100%
    end;
  finally
    SourceStream.Free;
    DestStream.Free;
  end;
end;

function RuFileCopyThread(aSourceName, aDestName: string;
                          aFileCopyMode: TFileCopyMode;
                          aFileCopyCallback: TFileCopyCallback): string;
begin
  with TRuFileCopyThread.Create(aSourceName, aDestName,
                          aFileCopyMode, aFileCopyCallback)
  do begin
    OnTerminate := ThreadIsReady;
    FreeOnTerminate := true;
    Start; // Thread wird gestartet
  end;
end;

{------------------------------------------------------------------------------}
{- TRuFileCopyThread ----------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TRuFileCopyThread.ThreadCopyCallback(ProgressPercent: Integer);
begin
  Synchronize(procedure
              begin
                FFileCopyCallback(ProgressPercent);
              end);
end;

procedure TRuFileCopyThread.ThreadIsReady(Sender: TObject);
begin
  RuFileCopyThreadResult := FCopyResult;
  Synchronize(procedure
              begin
                FFileCopyCallback(cRuFileCopyReady);
              end);
end;

constructor TRuFileCopyThread.Create(aSourceName, aDestName: string;
  aFileCopyMode: TFileCopyMode; aFileCopyCallback: TFileCopyCallback);
begin
  inherited Create(True); // True = Thread nicht automatisch starten
  FCopyResult := '';
  FSourceName := aSourceName;
  FDestName := aDestName;
  FFileCopyMode := aFileCopyMode;
  FFileCopyCallback := aFileCopyCallback;
  FreeOnTerminate := true;
end;

procedure TRuFileCopyThread.Execute;
begin
  if not Terminated
  then FCopyResult := RuFileCopyExecute(FSourceName, FDestName,
                                        FFileCopyMode, FFileCopyCallback);
end;

end.

// Hauptprogramm

type
  TForm1 = class(TForm)
  ...
  public
    { Public-Deklarationen }
    procedure ShowProgress(ProgressPercent: Integer);
  end;

...

procedure TForm1.ShowProgress(ProgressPercent: Integer);
begin
  ProgressBar1.Position := ProgressPercent;
  if ProgressPercent = cRuFileCopyReady
  then Label4.Caption := 'FERTIG: '+DateTimeToStr(Now)+' Result['+RuFileCopyThreadResult+']';
end;

Man kann während des Kopiervorganges das MainFormular beliebig bewegen, da friert absolut nichts ein und auch der ProgressBar geht schön durch.

ToDo:
- Exception-Behandlung :roll:
- Gibt es eine bessere Lösung für die globale Variable "RuFileCopyThreadResult" und die in der Unit lokalen Variablen StreamCopyBuffer und ProgressPercent [EDIT] Stichwort "ThreadSafe", weil man dann mehrere Dateien gleichzeitig kopieren könnte. Das wär's ;-)