unit maincopy; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn, FileUtil, LazUTF8, LazFileUtils; type { TForm1 } TForm1 = class(TForm) btnCopy: TButton; cbDate: TCheckBox; edtCopyFrom: TFileNameEdit; lblCopyToFile: TLabel; lblCopyFrom: TLabel; procedure btnCopyClick(Sender: TObject); procedure edtCopyFromAcceptFileName(Sender: TObject; var Value: String); private SourceFileName: string; CopiedFileName: string; procedure CopyFile(sourceName, destinationName: string; copyDateToo: boolean); end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.btnCopyClick(Sender: TObject); var append: string; begin CopyFile(SourceFileName, CopiedFileName, cbDate.Checked); btnCopy.Enabled := False; edtCopyFrom.Text := EmptyStr; case cbDate.Checked of False: append := ' created with current date'; True: append := ' created with original date'; end; lblCopyToFile.Caption := CopiedFileName + append; end; procedure TForm1.edtCopyFromAcceptFileName(Sender: TObject; var Value: String); var path, fName: string; begin if (Value = EmptyStr) then Exit; path := ExtractFilePath(Value); fName := ExtractFileName(Value); CopiedFileName := path + 'Copy of ' + fName; case FileExistsUTF8(CopiedFileName) of False: begin lblCopyToFile.Caption := 'File will be copied to: ' + CopiedFileName; btnCopy.Enabled := True; SourceFileName := Value; end; True: case QuestionDlg( 'Warning', CopiedFileName + ' already exists' + sLineBreak + 'Overwrite existing file?', mtWarning, [mrYes, 'Overwrite file', mrNo, 'Cancel file copy'], 0 ) of mrYes: begin lblCopyToFile.Caption := 'File will be copied to: ' + CopiedFileName; btnCopy.Enabled := True; SourceFileName := Value; end; else begin Value := EmptyStr; btnCopy.Enabled := False; SourceFileName := EmptyStr; CopiedFileName := EmptyStr; end; end; end; end; procedure TForm1.CopyFile(sourceName, destinationName: string; copyDateToo: boolean); var src: TFileStream = nil; dest: TFileStream = nil; begin if SameText(sourceName, destinationName) then Exit; src := TFileStream.Create(UTF8ToSys(sourceName), fmOpenRead); try dest := TFileStream.Create(UTF8ToSys(destinationName), fmOpenWrite or fmCreate); try dest.CopyFrom(src, src.Size); if CopyDateToo then FileSetDate(dest.Handle, FileGetDate(src.Handle)); finally dest.Free; end; finally src.Free; end; end; end.