实现高速文件拷贝

program FastCopy;
{$A+,B-,D-,E+,F+,G+,I-,L-,N+,P-,Q-,R-,S-,T-,V-,X-,Y-}
{$M 16384,$10000}

const
  MaxBufCnt = 1000;
type
  BufPtr = ^BufRec;
  BufRec = array[0..8190] of byte;

var
  InFile, OutFile : file; {IF is In File, OF is OutFile}
  Buffer : array[1..MaxBufCnt] of BufPtr;
  BufLen : array[1..MaxBufCnt] of word;
  BufSiz : array[1..MaxBufCnt] of word;
  BufCnt : byte;
  Total : longint;
  SizeofFile : longint;
  IndexR,IndexW : byte;
  BytesWritten : word;
  BR, BW : longint;
  Timer1,Timer2 : longint;
  Ticks : ^Longint;

begin
Ticks := Ptr(Seg0040, $006c);
if paramcount < 2 then begin
writeln('Usage:', paramstr(0), '

');
halt;
end;
assign(InFile, paramstr(1));
assign(OutFile, paramstr(2));
writeln;
writeln('Copying ', paramstr(1), ' to ', paramstr(2));
reset(InFile, 1);
rewrite(OutFile, 1);
BufCnt := 0;
SizeOfFile := filesize(InFile);
Total := 0;
while (MaxAvail>8192) and (BufCnt
BufLen[IndexW] then begin
    writeln;
    writeln('Error writing to file... Disk might be full');
    Halt;
   end;
  end;
end;
Close(InFile);
Close(OutFile);
Timer2 := ticks^;
writeln;
writeln('Copy took ', Timer2-Timer1, ' timer ticks to complete');
writeln('Throughput is ', SizeOfFile div (Timer2-Timer1), ' bytes/tick');
writeln('or if you prefer ', (SizeOfFile div (Timer2-Timer1)) * 18.2:8:0, '
bytes/second'); for IndexR := 1 to BufCnt do
  freemem(Buffer[IndexR], BufSiz[IndexR]);
writeln;
writeln('Copy complete');
end.

（出处：清风网络学院）