CONST
     BUFSize    = 8192;
var
{FReadBuf}
   RBBuf, RBread    : ^BYTE;
   RBcount          : word;
   RBsize           : word;
   RBFirst, RBLast  : boolean;
{FReadBuf}
Function FReadBuf(var F:FILE;var val:byte):boolean;
begin
  if RBFirst then
   begin
    RBfirst:=false;
    GetMem(RBBuf,BUFSize);
    RBcount:=0;
    RBSize:=0;
   end;
  if RBLast then
   begin
    RBLast:=false;
    FreeMem(RBBuf,BufSize);
    RBFirst:=true;
    exit;
   end;
  If RBcount=RBsize then
   begin
     BlockRead(F,RBBuf^,BufSize,RBsize);
    if Rbsize=0 then
      begin
        FReadBuf:=false;
        exit;
      end;
     RBcount:=0;
   end;
  RBread:=PTR(SeG(RBBUF^),Ofs(RBbuf^)+RBcount);
  inc(RBcount);
  val:=RBread^;
  FReadBuf:=true;
end; {FReadBuf}
{-----------------------------------------}
var
{FWriteBuf}
   WBBuf,WBwrt      : ^BYTE;
   WBcount          : word;
   WBFirst, WBLast  : boolean;
{FWritebuf}
Procedure FWriteBuf(var F:FILE;val:byte);
begin
  if WBFirst then
   begin
    WBfirst:=false;
    GetMem(WBBuf,BUFSize);
    WBcount:=0;
   end;
  if WBLast then
   begin
    WBLast:=false;
    BlockWrite(F,WBBuf^,WBcount);
    FreeMem(WBBuf,BufSize);
    WBFirst:=true;
    exit;
   end;
  WBwrt:=PTR(SeG(WBBUF^),Ofs(WBbuf^)+WBcount);
  inc(WBcount);
  WBwrt^:=val;
  If WBcount=BUFsize then
   begin
     BlockWrite(F,WBBuf^,WBcount);
     WBcount:=0;
   end;
end;{FWriteBuf}

var
  i     : byte;
  INP   : FILE;
  OUT   : FILE;
BEGIN
  Assign(OUT,'test2.dat');
  Rewrite(OUT,1);
  Assign(INP,'test.dat');
  Reset(INP,1);
  WBFirst:=true;
  WBLast:=false;
  RBFirst:=true;
  RBLast:=false;
  WHILE FreadBuf(INP,i) do FWriteBuf(OUT,i);
  WBLast:=true;
  RBLast:=true;
  FWriteBuf(OUT,0);
  FReadBuf(INP,i);
  Close(OUT);
  Close(Inp);
END.