Author: Ronald Buster
How to COPY a file with or without a progressbar
Answer:
1
2 function FileCopy(const SourceFile, TargetFile: string): Boolean; overload;
3 function FileCopy(const SourceFile, TargetFile: string; PB: TProgressBar): Boolean;
4 overload;
5
6 function FileCopy(const SourceFile, TargetFile: string): Boolean;
7 begin
8 Result := FileCopy(SourceFile, TargetFile, nil);
9 end;
10
11 function FileCopy(const SourceFile, TargetFile: string; PB: TProgressBar):
12 Boolean;
13 const
14 BlockSize = 1024 * 16;
15 var
16 FSource, FTarget: Integer;
17 BRead, Bwrite: Word;
18 Buffer: Pointer;
19 begin
20 Result := False;
21
22 FSource := FileOpen(SourceFile, fmOpenRead + fmShareDenyNone); { Open Source }
23
24 if FSource >= 0 then
25 try
26 if Assigned(PB) then
27 begin
28 PB.Position := 0;
29 pb.Min := 0;
30 pb.Max := (FileSeek(FSource, 0, 2));
31 if (pb.Max > 2048) then
32 pb.Step := pb.Max div 2048
33 else
34 pb.Step := pb.Max;
35 FileSeek(FSource, 0, 0);
36 end;
37 FTarget := FileCreate(TargetFile); { Open Target }
38 try
39 getmem(Buffer, BlockSize);
40 try
41 FileSeek(FSource, 0, soFromBeginning);
42 repeat
43
44 BRead := FileRead(FSource, Buffer^, BlockSize);
45
46 if assigned(PB) then
47 PB.StepIt;
48
49 BWrite := FileWrite(FTarget, Buffer^, Bread);
50
51 if assigned(PB) then
52 PB.StepIt;
53
54 until (Bread = 0) or (Bread <> BWrite);
55 if Bread = Bwrite then
56 begin
57 Result := True;
58 if assigned(PB) then
59 PB.Position := PB.Max;
60 end;
61 finally
62 freemem(Buffer, BlockSize);
63 end;
64 FileSetDate(FTarget, FileGetDate(FSource));
65 finally
66 FileClose(FTarget);
67 end;
68 finally
69 FileClose(FSource);
70 end;
71 end;
|