unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
ProgressBar: TProgressBar;
OpenDialog1: TOpenDialog;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
SaveDialog1: TSaveDialog;
Button4: TButton;
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
function copywithprogress(Src, Dest:
String): Boolean;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
Stopped: Boolean;
implementation
{$R *.dfm}
{$WARNINGS OFF}
function TForm1.copywithprogress(Src, Dest:
String): Boolean;
const
BufferSize = 102400;
//100 KByte
var
SizeOfFile, BytesCopied: LongInt;
Size: Integer;
Buffer:
Array [0..BufferSize]
of Byte;
FInFile, FOutFile:
File;
Time: Cardinal;
FilePathSource, FilePathDestination:
String;
begin
Result := False;
if not fileexists(Src)
then
begin
raise Exception.Create('
Source File Doesnt Exist');
exit;
end;
if Src = Dest
then
begin
raise EInOutError.Create('
Source and Destination File are equal');
exit;
end;
Stopped := False;
Time := GetTickCount;
AssignFile(FInFile, Src);
AssignFile(FOutFile, Dest);
try //Reset Try BEGIN
Reset(FInFile,1);
try //ReWrite Try BEGIN
ReWrite(FOutFile,1);
try
SizeOfFile := FileSize(FInFile);
ProgressBar.Max := SizeOfFile;
ProgressBar.Position := 0;
BytesCopied := 0;
FilePathSource := ExtractFilePath(Src);
FilePathDestination := ExtractFilePath(Dest);
if Length(FilePathSource) > 20
then
FilePathSource := Copy(FilePathSource,1,15) + '
...';
if Length(FilePathDestination) > 20
then
FilePathDestination := Copy(FilePathDestination,1,15) + '
...';
Label1.Caption := '
Von ' + FilePathSource + '
nach ' + FilePathDestination;
repeat
if stopped = True
then
begin
CloseFile(FInFile);
CloseFile(FOutFile);
Progressbar.Position := 0;
Label1.Caption := '
';
Form1.Caption := '
FileCopy';
if MessageBox(Self.Handle,
'
Copying Process Stopped. Delete The Destination File?',
'
Stopped',
MB_YESNO
or MB_ICONQUESTION) = ID_YES
then
DeleteFile(SaveDialog1.FileName);
Result := False;
break;
Exit;
end;
BlockRead(FInFile, Buffer, BufferSize, Size);
Inc(BytesCopied, Size);
Form1.Caption := '
MBytes Copied: ' + IntToStr(BytesCopied
div 1024
div 1024);
ProgressBar.Position := BytesCopied;
BlockWrite(FOutFile, Buffer, Size);
Application.ProcessMessages;
until Size < BufferSize;
finally
RaiseLastOSError;
end;
finally //ReWrite Try Finally
CloseFile(FOutFile);
end;
//ReWrite Try END
except //Reset Try Finally
CloseFile(FInFile);
end;
//Reset Try END
Result := True;
Time := GetTickCount - Time;
Form1.Caption := Form1.Caption + '
Finished in ' + IntToStr(Time) + '
ms';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Button4.Enabled := True;
if CopyWithProgress(OpenDialog1.FileName, SaveDialog1.FileName)
then
MessageBox(Self.Handle,
'
Copying Finished',
'
Information',
MB_ICONINFORMATION);
Button4.Enabled := False;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute
then
SaveDialog1.Filter := StrLower(PChar(ExtractFileExt(OpenDialog1.FileName)));
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if OpenDialog1.FileName = '
'
then
begin
MessageBox(Self.Handle,
'
Please Select A Source File First',
'
Information',
MB_ICONINFORMATION);
exit;
end;
if SaveDialog1.Execute
then
if StrLower(PChar(ExtractFileExt(Savedialog1.FileName))) <> Savedialog1.Filter
then
SaveDialog1.FileName := SaveDialog1.FileName + SaveDialog1.Filter;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Stopped := True;
end;
end.