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.