Kopierstatus in eigener ProgressBar?

[Whistler]

Guten Morgen,

in diesem Beitrag erklöärt "sakura" schön wie man Mittels ShellAPI Dateien kopiert.

Im Normalfall würde die Funktion den stnd. Windows-Kopier-Dialog öffnen. Dies kann man Mittels "FOF_SILENT" unterdrücken - aber kann ich ich die Fortschrittsanzeige auch in eine ProgressBar von mir "umleiten"?

Außerdem:
Wenn der Vorgang aktiv ist, reagiert die Anwendung mehr oder weniger nicht. Kann ich das verhindern/umgehen?

[Luckie]

Zwei Fragen, zwei Threads bitte.

Nein, das geht nicht. Wenn du was mit Fortschrittsanzeige kopieren willst, dann kuck dir das mal an: http://www.luckie-online.de/Downloads/Sonstiges/ -> TStreamProgressAdapter.

[nailor]

und threads ist auch die antwort auf die frage mit dem stehenbleiben.

[NicoDE]

Alternative für Copy 'n Paste Liebhaber (die gerne meine Bugs fixen ;))

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
//
// CopyFileEx Wrapper
//

type
  PProgressRoutine = ^TProgressRoutine;
  TProgressRoutine = function(TotalFileSize, TotalBytesTransferred, StreamSize,
    StreamBytesTransferred: TLargeInteger; StreamNumber, CallbackReason: DWORD;
    SourceFile, DestinationFile: THandle; Data: Pointer): DWORD; stdcall;

type
  TFNCopyFileExA = function(ExistingFileName, NewFileName: LPCSTR;
    ProgressRoutine: TProgressRoutine; Data: Pointer; Cancel: PBOOL;
    CopyFlags: DWORD): BOOL; stdcall;
  TFNCopyFileExW = function(ExistingFileName, NewFileName: LPCWSTR;
    ProgressRoutine: TProgressRoutine; Data: Pointer; Cancel: PBOOL;
    CopyFlags: DWORD): BOOL; stdcall;
{$IFDEF UNICODE}
  TFNCopyFileEx = TFNCopyFileExW;
{$ELSE}
  TFNCopyFileEx = TFNCopyFileExA;
{$ENDIF UNICODE}

var
  FNCopyFileExW: TFNCopyFileExW;

function MyCopyFileExW(ExistingFileName, NewFileName: LPCWSTR;
  ProgressRoutine: TProgressRoutine; Data: Pointer; Cancel: PBOOL;
  CopyFlags: DWORD): BOOL; stdcall;
var
  FindFile: THandle;
  FindData: TWin32FindDataW;
  FileSize: TLargeInteger;
  Progress: DWORD;
begin
  Result := False;
  if not Assigned(FNCopyFileExW) then
    FNCopyFileExW := TFNCopyFileExW(
      GetProcAddress(GetModuleHandleW(kernel32), 'CopyFileExW'));
  if Assigned(FNCopyFileExW) then
    Result := FNCopyFileExW(ExistingFileName, NewFileName, ProgressRoutine,
      Data, Cancel, CopyFlags);
  if not Result and (ERROR_CALL_NOT_IMPLEMENTED = GetLastError) then
  begin
    FindFile := FindFirstFileW(ExistingFileName, FindData);
    if FindFile <> INVALID_HANDLE_VALUE then
      try
        with FindData do
          FileSize := nFileSizeHigh * (Int64(MAXDWORD) + 1) + nFileSizeLow;
        if Assigned(ProgressRoutine) then
          Progress := ProgressRoutine(FileSize, 0, FileSize, 0, 0,
            CALLBACK_STREAM_SWITCH, INVALID_HANDLE_VALUE, INVALID_HANDLE_VALUE,
            nil)
        else
          Progress := PROGRESS_CONTINUE;
        if Progress in [PROGRESS_CONTINUE, PROGRESS_QUIET] then
        begin
          Result := CopyFileW(ExistingFileName, NewFileName,
            CopyFlags and COPY_FILE_FAIL_IF_EXISTS = COPY_FILE_FAIL_IF_EXISTS);
          if Result and Assigned(ProgressRoutine) and
            (Progress <> PROGRESS_QUIET) then
            if PROGRESS_CANCEL = ProgressRoutine(FileSize, FileSize, FileSize,
              FileSize, 0, CALLBACK_CHUNK_FINISHED, INVALID_HANDLE_VALUE,
              INVALID_HANDLE_VALUE, nil) then
            begin
              DeleteFileW(NewFileName);
              Result := False;
            end;
        end;
      finally
        Windows.FindClose(FindFile);
      end;
  end;
end;

var
  FNCopyFileExA: TFNCopyFileExA;

function MyCopyFileExA(ExistingFileName, NewFileName: LPCSTR;
  ProgressRoutine: TProgressRoutine; Data: Pointer; Cancel: PBOOL;
  CopyFlags: DWORD): BOOL; stdcall;
var
  FindFile: THandle;
  FindData: TWin32FindDataA;
  FileSize: TLargeInteger;
  Progress: DWORD;
begin
  Result := False;
  if not Assigned(FNCopyFileExA) then
    FNCopyFileExA := TFNCopyFileExA(
      GetProcAddress(GetModuleHandleA(kernel32), 'CopyFileExA'));
  if Assigned(FNCopyFileExA) then
    Result := FNCopyFileExA(ExistingFileName, NewFileName, ProgressRoutine,
      Data, Cancel, CopyFlags);
  if not Result and (ERROR_CALL_NOT_IMPLEMENTED = GetLastError) then
  begin
    FindFile := FindFirstFileA(ExistingFileName, FindData);
    if FindFile <> INVALID_HANDLE_VALUE then
      try
        with FindData do
          FileSize := nFileSizeHigh * (Int64(MAXDWORD) + 1) + nFileSizeLow;
        if Assigned(ProgressRoutine) then
          Progress := ProgressRoutine(FileSize, 0, FileSize, 0, 0,
            CALLBACK_STREAM_SWITCH, INVALID_HANDLE_VALUE, INVALID_HANDLE_VALUE,
            nil)
        else
          Progress := PROGRESS_CONTINUE;
        if Progress in [PROGRESS_CONTINUE, PROGRESS_QUIET] then
        begin
          Result := CopyFileA(ExistingFileName, NewFileName,
            CopyFlags and COPY_FILE_FAIL_IF_EXISTS = COPY_FILE_FAIL_IF_EXISTS);
          if Result and Assigned(ProgressRoutine) and
            (Progress <> PROGRESS_QUIET) then
            if PROGRESS_CANCEL = ProgressRoutine(FileSize, FileSize, FileSize,
              FileSize, 0, CALLBACK_CHUNK_FINISHED, INVALID_HANDLE_VALUE,
              INVALID_HANDLE_VALUE, nil) then
            begin
              DeleteFileA(NewFileName);
              Result := False;
            end;
        end;
      finally
        Windows.FindClose(FindFile);
      end;
  end;
end;

const
{$IFDEF UNICODE}
  MyCopyFileEx: TFNCopyFileEx = MyCopyFileExW;
{$ELSE}
  MyCopyFileEx: TFNCopyFileEx = MyCopyFileExA;
{$ENDIF UNICODE}

////////////////////////////////////////////////////////////////////////////////
//
//  CopyFileWithProgress
//

type
  PMyCopyFileExRoutineData = ^TMyCopyFileExRoutineData;
  TMyCopyFileExRoutineData = record
    ProgressBar    : TProgressBar;
    ProcessMessages: Boolean;
  end;

function MyCopyFileExRoutine(TotalFileSize, TotalBytesTransferred, StreamSize,
  StreamBytesTransferred: TLargeInteger; StreamNumber, CallbackReason: DWORD;
  SourceFile, DestinationFile: THandle; Data: Pointer): DWORD; stdcall;
begin
  if Assigned(Data) then
    with PMyCopyFileExRoutineData(Data)^ do
    begin
      if Assigned(ProgressBar) then
        with ProgressBar do
          case CallbackReason of
            CALLBACK_STREAM_SWITCH:
              Position := Min;
            CALLBACK_CHUNK_FINISHED:
              if StreamSize > 0 then
                Position := Min +
                  StreamBytesTransferred * (Max - Min) div StreamSize;
          end;
      if ProcessMessages then
        Application.ProcessMessages;
    end;
  Result := PROGRESS_CONTINUE;
end;

function MyCopyFileWithProgress(const ExistingFileName, NewFileName: string;
  ProgressBar: TProgressBar; FailIfExist: Boolean;
  ProcessMessages: Boolean = False): Boolean;
var
  CopyFlags: DWORD;
  MyCopyDat: TMyCopyFileExRoutineData;
begin
  if FailIfExist then
    CopyFlags := COPY_FILE_FAIL_IF_EXISTS
  else
    CopyFlags := 0;
  MyCopyDat.ProgressBar     := ProgressBar;
  MyCopyDat.ProcessMessages := ProcessMessages;
  Result := MyCopyFileEx(PChar(ExistingFileName), PChar(NewFileName),
    MyCopyFileExRoutine, @MyCopyDat, nil, CopyFlags);
end;

// Test

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute and SaveDialog1.Execute then
  begin
    Button1.Enabled := False;
    try
      if MyCopyFileWithProgress(OpenDialog1.FileName, SaveDialog1.FileName,
        ProgressBar1, False, True) then
        ShowMessage('done')
      else
        ShowMessage(SysErrorMessage(GetLastError));
    finally
      Button1.Enabled := True;
    end;
  end;
end;

[Luckie]

Gibt es einen Grund warum du das alles dynamisch lädst?

Ich hatte das mal so gemacht:

Delphi-Quellcode:

function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
  StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason,
  hSourceFile, hDestinationFile, lpData: DWORD): DWORD; stdcall;
begin
  Application.ProcessMessages;
  if CancelCopy = True then
  begin
    Form1.ProgressBar1.Position := 0;
    result := PROGRESS_CANCEL;
    exit;
  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;
    else
      result := PROGRESS_CONTINUE;
  end;
end;

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

procedure TForm1.Button2Click(Sender: TObject);
begin
  CancelCopy := True;;
end;

Ist meines Wissens schon alles in der Windows.pas deklariert.

[NicoDE]

Zitat:

Zitat von Luckie

Gibt es einen Grund warum du das alles dynamisch lädst?

Ich dachte an Win95, aber ist eigentlich überflüssig...

[NicoDE]

Zitat:

Zitat von Luckie

Delphi-Quellcode:

ProgressBar1.Position := TotalBytesTransferred.QuadPart;
//...
ProgressBar1.Max := TotalFileSize.QuadPart;

Spätestens bei >2GB wirds problematisch. Und wenn die VCL PBM_SETRANGE anstatt PBM_SETRANGE32 verwendet, wird's ab 64K merwürdig. Bei meinem Code oben ist zudem egal, ob die ProgressBar auf 0-100, 0-1000 oder 5000-10000 eingestellt wurde (bei ersterem hätte man gleich die Prozentzahl :))...

[Whistler]

Hört sich ja alles soweit gut an, nur ich will ja den Inhalt einer CD bzw. eines Ordners (also viele Unterordner/Dateien) kopieren und nicht nur ein File. Geht das mit euren Code-Schnipseln? Da diese nach ersten Überfliegen für mich nur auf ein File ausgelegt sind...

[NicoDE]

Zitat:

Zitat von Whissi

Geht das mit euren Code-Schnipseln?

Nein.

Zitat:

Zitat von Whissi

Da diese nach ersten Überfliegen für mich nur auf ein File ausgelegt sind...

So ist es.

[Whistler]

Schade :(

Ich werde dann mal was herum spielen. Eigentlich muss ich ja nur eine Liste mit allen Dateien/Unterordnern der zu kopierenden Ressource füllen.
Nun nehme ich "Max" der Progressbar div Count-1 der Liste und habe die Position einer Datei auf dem Balken.
Jetzt kopiere ich eine Datei und und erhöhe die ProgressBar.Position um den errechneten Wert und gehe zur nächsten...

Einfach...
...in der Theorie ;)