unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
getPath = 'c: empget.rar';
setPath = 'c: empset.rar';
var
getStream,setStream: TFileStream;
num, n: Integer;
buf: PByte;
BufSize,block: Integer;
begin
if not FileExists(getPath) then
begin
ShowMessage('源文件不存在');
Exit;
end;
getStream := TFileStream.Create(getPath, fmOpenRead or fmShareExclusive);
setStream := TFileStream.Create(setPath, fmCreate);
num := getStream.Size;
setStream.Size := num;
getStream.Position := 0;
setStream.Position := 0;
BufSize := num;
block := BufSize div 100;
GetMem(buf, BufSize);
ProgressBar1.Max := 100;
ProgressBar1.Min := 0;
ProgressBar1.Position := 0;
while num <> 0 do
begin
Application.ProcessMessages;
n := block;
if n > num then n := num;
getStream.ReadBuffer(buf^, n);
setStream.WriteBuffer(buf^, n);
ProgressBar1.Position := Trunc((1 - num / BufSize) * 100);
Dec(num, n);
end;
FreeMem(buf, BufSize);
getStream.Free;
setStream.Free;
ShowMessage('復制完畢');
ProgressBar1.Position := 0;
end;
end.
窗體文件:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClIEntHeight = 104
ClIEntWidth = 265
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 96
Top = 56
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object ProgressBar1: TProgressBar
Left = 8
Top = 16
Width = 249
Height = 17
TabOrder = 1
end
end
