Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi CopyFileEx (https://www.delphipraxis.net/27298-copyfileex.html)

Luckie 7. Aug 2004 14:19


CopyFileEx
 
So, ich habe gerade ein Beispiel für das Kopieren einer Datei mit Fortschrittsanzeige mit Hilfe von MSDN-Library durchsuchenCopyFileEx geschrieben:
Delphi-Quellcode:
var
  Form1: TForm1;
  CancelCopy: Boolean;

implementation

{$R *.dfm}

function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
  StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason,
  hSourceFile, hDestinationFile, lpData: DWORD): DWORD; stdcall;
begin
  Application.ProcessMessages;
  if CancelCopy = True then
  begin
    ShowMessage('Abbruch');
    result := PROGRESS_CANCEL;
  end;
  case dwCallbackReason of
    CALLBACK_CHUNK_FINISHED:
      begin
        Form1.ProgressBar1.Position := TotalBytesTransferred.QuadPart;
        result := PROGRESS_CONTINUE;
      end;
    CALLBACK_STREAM_SWITCH:
      begin
        Form1.ProgressBar1.Max := TotalFileSize.QuadPart;
        result := PROGRESS_CONTINUE;
      end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Cancel: PBOOL;
begin
  CancelCopy := False;
  Cancel := nil;
  CopyFileEx('g:\Brennen\Madonna - Erotica.mpg', 'g:\Madonna - Erotica.mpg',
    @CopyFileProgress, nil, Cancel, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CancelCopy := True;;
end;
Nur ein Problem habe ich: Das Abbrechen funktioniert nicht. Er geht zwar in den if-Zweig rein, aber er ruft die Callback Routine immer wieder auf, obwohl ich PROGRESS_CANCEL zurückgebe.

NicoDE 7. Aug 2004 14:46

Re: CopyFileEx
 
Versuchs mit
Delphi-Quellcode:
  if CancelCopy = True then
  begin
    ShowMessage('Abbruch');
    Result := PROGRESS_CANCEL;
    Exit;
  end
  else
    Application.ProcessMessages;
BTW, Application.ProcessMessages führt eine Ansychronität ein, die Du vermutlich nicht haben willst. Und Du solltest bei Abbruch die Funktion verlassen, sonst wird Dein Result wieder überschrieben. Zudem ist auf den ersten Blick der Rückgabewert nicht immer definiert (noch nicht ganz wach?).

Gruss Nico

wolke 3. Sep 2005 02:22

Re: CopyFileEx
 
^hochhol.

danke für den code. wenn Application.ProcessMessages nicht empfehlenswert ist, was gibt es als alternative? ich will ja nicht daß mein programm nicht mehr reagiert.

kann ich die priorität des kopierprozesses durch die priorität meines programmes beeinflussen?

ich habe den code so abgeändert, daß statt PROGRESS_CANCEL ein PROGRESS_STOP zurückgegeben wird, zusätzlich setze ich als flag COPY_FILE_RESTARTABLE. wenn ich nun die aktion stoppe und nochmal starte sollte er doch fortsetzen, tut es aber nicht. wieso?

Luckie 3. Sep 2005 02:36

Re: CopyFileEx
 
Threads wären besser:
Delphi-Quellcode:
type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WndProc(var Msg: TMessage); override;
  end;

var
  Form1                  : TForm1;

implementation

{$R *.dfm}

type
  TCopyEx = packed record
    Source: String[255];
    Dest: String[255];
    Handle: THandle;
  end;
  PCopyEx = ^TCopyEx;

const
  CEXM_CANCEL           = WM_USER + 1;
  CEXM_CONTINUE         = WM_USER + 2; // wParam: lopart, lParam: hipart
  CEXM_MAXBYTES         = WM_USER + 3; // wParam: lopart; lParam: hipart

var
  CancelCopy            : Boolean = False;

function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
  StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason,
  hSourceFile, hDestinationFile: DWORD; lpData: Pointer): DWORD; stdcall;
begin
  if CancelCopy = True then
  begin
    SendMessage(THandle(lpData), CEXM_CANCEL, 0, 0);
    result := PROGRESS_CANCEL;
    exit;
  end;
  case dwCallbackReason of
    CALLBACK_CHUNK_FINISHED:
      begin
        SendMessage(THandle(lpData), CEXM_CONTINUE, TotalBytesTransferred.LowPart, TotalBytesTransferred.HighPart);
        result := PROGRESS_CONTINUE;
      end;
    CALLBACK_STREAM_SWITCH:
      begin
        SendMessage(THandle(lpData), CEXM_MAXBYTES, TotalFileSize.LowPart, TotalFileSize.HighPart);
        result := PROGRESS_CONTINUE;
      end;
  else
    result := PROGRESS_CONTINUE;
  end;
end;

procedure TForm1.WndProc(var Msg: TMessage);
begin
  inherited;
  case Msg.Msg of
    CEXM_MAXBYTES:
      begin
        ProgressBar1.Max := Msg.WParam + Msg.LParam;
      end;
    CEXM_CONTINUE:
      begin
        Progressbar1.Position := Msg.WParam + Msg.LParam;
        Caption := IntToStr(Msg.WParam + Msg.LParam);
      end;
    CEXM_CANCEL:
    begin
      Progressbar1.Position := 0;
      Caption := '0';
    end;
  end;
end;

function CopyExThread(p: PCopyEx): Integer;
var
  Source: String;
  Dest: String;
  Handle: THandle;
  Cancel                : PBool;
begin
  Source := p.Source;
  Dest := p.Dest;
  Handle := p.Handle;
  Cancel := PBOOL(False);

  CopyFileEx(PChar(Source), PChar(Dest), @CopyFileProgress, Pointer(Handle), Cancel, 0);

  Dispose(p);
  result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Params: PCopyEx;
  ThreadID: Cardinal;
begin
  cancelCopy := False;
  New(Params);
  Params.Source := 'H:\Videos ungebrannt\Gwen Stefani - rich girl.mpeg';
  Params.Dest := 'H:\test.mpeg';
  Params.Handle := Handle;
  CloseHandle(BeginThread(nil, 0, @CopyExThread, Params, 0, ThreadID));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CancelCopy := True;
end;
Ungefähr so.

wolke 3. Sep 2005 02:46

Re: CopyFileEx
 
auch noch so spät unterwegs? :-D

wie, threads? also einen thread erstellen, der die kopieraktion dann macht?
habe mich noch nicht wirklich mit threadprogrammierung beschäftigt, kannst du mir ein grobes gerüst zusammenschustern?

ich möchte sehr "performant" viele dateien kopieren/verschieben und kann auf 9x verzichten, habe mir deshalb CopyFileEx/MoveFileEx herausgesucht. vielleicht mache ichs aber doch mit blockread/write, weil ich dann bei netzwerkkopieraktionen den durchsatz limitieren kann.

Luckie 3. Sep 2005 03:43

Re: CopyFileEx
 
Zitat:

Zitat von wolke
auch noch so spät unterwegs? :-D

Ich musste den zweiten Teil von Richter Alexander Holt noch sehen. Man muss ja wissen, wer der Mörder ist. ;)

Zitat:

wie, threads? also einen thread erstellen, der die kopieraktion dann macht?
habe mich noch nicht wirklich mit threadprogrammierung beschäftigt, kannst du mir ein grobes gerüst zusammenschustern?
Jupp, genau wie ich es oben gezeigt habe. Das mit Application.Processmessage war nur eine Quick and Dirty Lösung.

wolke 3. Sep 2005 11:24

Re: CopyFileEx
 
danke!

nachdem du deinen beitrag editiert hast schaut es jetzt so aus als hätte ich um 4 uhr morgens nur nicht gesehen daß du ja schon ein beispiel gepostet hast! :)

kann ich die priorität des kopierprozesses durch die priorität meines threads beeinflussen?

Luckie 3. Sep 2005 11:29

Re: CopyFileEx
 
Sollte möglich sein. Probier es aus. Aber generell würde ich an den Prioritäten nichts ändern, ins besondere, wenn es um das Anheben der Priorität geht. In der Zuteilung von Rechenzeit findet Windows meist schon selber das richtige Maß. Man kann durch Anheben fast mehr kaputt machen, als verbessern.

wolke 3. Sep 2005 12:01

Re: CopyFileEx
 
ich möchte die priorität nicht anheben, sondern senken. :) ich probiers mal, danke.

masadafish 8. Apr 2006 16:23

Re: CopyFileEx
 
hi
ich wollt mich zunächst für das tolle beispiel bedanken
aber ich habe ein problem denn sobald ich datein die größer als ca 2gb sind kopieren will stimmt die progressbar nicht mehr da der progrssbar.max wert ja ein integer
ist und msg.lparam und msg.wparam ja auch "nur" integer sind ... steh ich jetz nur auf der leitung oder ist was wirklich schwierig?
also hat wer ne ahnung wie man das abändern kann das es auch mit größeren datein funzt?


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:48 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz