procedure mycopyfile(sourcef,targetf:string;i:integer); var FromF,ToF:file; NumRead,NumWritten:Integer; Buf:array[1..2048] of Char; n:integer; begin AssignFile(FromF,sourcef); Reset(FromF, 1); { Record size = 1 } AssignFile(ToF,targetf); { Open output file } Rewrite(ToF, 1); { Record size = 1 } n:=0; repeat BlockRead(FromF, Buf, SizeOf(Buf), NumRead); form1.ProgressBar1.Position:=sizeof(buf)*n*100 div FileSize(FromF)*i div 4; application.ProcessMessages; //显示进度 BlockWrite(ToF, Buf, NumRead, NumWritten); inc(n); until (NumRead = 0) or (NumWritten <> NumRead); form1.ProgressBar1.Position:=100; CloseFile(FromF); CloseFile(ToF); end;
完整代码:
以下例子是关于delphi复制文件,加上进度条的方法的例子的关键代码: procedure TForm1.Button1Click(Sender: TObject); const getPath = 'c:/temp/get.rar'; setPath = 'c:/temp/set.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.
http://blog.csdn.net/shuaihj/article/details/6129551