Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
Delphi 10 Seattle Enterprise
|
AW: CopyFile Datei wird nicht überschrieben
14. Okt 2015, 10: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)
|
|
Zitat
|