121 lines
2.5 KiB
ObjectPascal
121 lines
2.5 KiB
ObjectPascal
|
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.
|
||
|
|
|