Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#21

AW: CopyFile Datei wird nicht überschrieben

  Alt 14. Okt 2015, 09:02
Also das funktioniert ganz wunderbar
Delphi-Quellcode:
uses
  System.IOUtils,
  System.SysUtils,
  System.Types;

procedure CopyFiles(
  const SourceFiles : array of string;
  const DestinationFolder: string;
  FileExistsCallback : TFunc<string, Boolean>;
  FileFailCallback : TProc<string, string> );
var
  Index : Integer;
  Source, Target: string;
  FailIfExists : Boolean;
  LastError : Cardinal;
begin
  for index := low( SourceFiles ) to high( SourceFiles ) do
    begin
      Source := SourceFiles[ index ];
      Target := TPath.Combine( DestinationFolder, TPath.GetFileName( Source ) );
      FailIfExists := True;

      while True do
        begin
          if not CopyFile( PChar( Source ), PChar( Target ), FailIfExists )
          then
            begin
              LastError := GetLastError;
              if ( LastError <> ERROR_FILE_EXISTS ) or not FailIfExists
              then
                begin
                  FileFailCallback( Source, SysErrorMessage( LastError ) );
                  Break;
                end;

              if not FileExistsCallback( Source )
              then
                begin
                  FileFailCallback( Source, 'UserChoice' );
                  Break;
                end;

              FailIfExists := False;
            end
          else
            Break;
        end;
    end;
end;

procedure TForm1.Button1Click( Sender: TObject );
var
  SourceFiles : TStringDynArray;
  DestinationFolder: string;
begin
  SourceFiles := TDirectory.GetFiles( TPath.GetDocumentsPath );
  DestinationFolder := TPath.GetTempPath;

  ListBox1.Items.Clear;

  CopyFiles( SourceFiles, DestinationFolder,
    function( Filename: string ): Boolean
    begin
      ListBox1.Items.Add( 'EXISTS: ' + Filename );
      Result := MessageDlg(
        {} string.Format( 'Die Datei %s existiert bereits' + sLineBreak + 'Soll diese überschrieben werden?', [ Filename ] ),
        {} mtWarning,
        {} mbYesNo,
        {} 0 ) = mrYes;
    end,
    procedure( Filename, Reason: string )
    begin
      ListBox1.Items.Add( 'FAILS: ' + Filename + ' REASON: ' + Reason );
    end );
end;
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat