copiar fichero mas de 2Gb con esta funcion

[aram2r]

Hola amigos, utilizo esta clasica *funcion para copiar un fichero con cierta perioridad, y ha estado funcionando perfectamente hasta que el fichero ha sobrepasdo las 3Gb no me copia mas de 2.033.000, hasta en un fichero de 18Gb solo me copia las 2 primeras..........

He probado en la condicion del bucle a poner

  While not Eof(Origen) do

Pero me sigue copiando solo 2Gb ??????? Xq???

Que puedo hacer para copiar ficheros de mas de 2Gb con barra de proceso......xq con CopyFile se copia bien pero tiene el incoveniente que deja la aplicacion frita mientras copia......

*funcion:

procedure TForm1.copiarConProgreso(ArchivoOrigen, ArchivoDestino: String);
var
  Origen,
  Destino  :file of byte;
  Buffer   :array[0..4096] of char;
  Leidos   :integer;
  Longitud :LongInt;
begin
 {Abrimos fichero Origen y Destino}
 AssignFile(Origen,ArchivoOrigen);
 reset(Origen);
 AssignFile(Destino,ArchivoDestino);
 rewrite(Destino);
 {Hallamos la longitud del fichero a copiar}
 Longitud:=FileSize(Origen);
 {Actualizamos limites de la ProgressBar}
 PB1.Max:=Longitud;
 PB1.Min:=0;
 while Longitud >0 do
 begin
   BlockRead(Origen,Buffer[0],SizeOf(Buffer),Leidos);
   Longitud:=Longitud-Leidos;
   BlockWrite(Destino,Buffer[0],Leidos);
   PB1.Position:=PB1.Position+Leidos;
   Application.ProcessMessages;
 end;
 CloseFile(Origen);
 CloseFile(Destino);
 PB1.Position:=0;
end;