Запись на HD больших файлов [РЕШЕНО]

[Владимир]

Всем доброго!
Записываю образ флешки в файл блоками по 512 кб. (Лазарус под Linux)

Код: Выделить всё

for i := 1 to Count do begin
    BlockRead (Fi, Bf[0], BlockSize, Sz); //читаем блок из файла
    if Sz = 0   then break; //кончилось чтение
    BlockWrite(Fo, Bf[0], Sz,     Wr); //пишем блок
end;


В разделе диска доступно 17 Гб из 30. Файл (флешка) размером 1 Гб пишется без проблем. Запись файла 8 Гб останавливается на 4,2 Гб с сообщением Disc full.
На другой машине доступно 44 Гб, при записи 16 Гб останавливается на 11,9 Гб с сообщением Disc full.
Кто виноват и что делать?

[Alex2013]

1 Флешки обычно размечают в Fat32 (или ExtFat)
2 "Второй упор" возможно связан с типом переменной i ( нужен Cardinal или int64)

[Владимир]

1 Флешки обычно размечают в Fat32 (или ExtFat)
2 "Второй упор" возможно связан с типом переменной i ( нужен Cardinal или int64)

1. Работаю с флешкой как с устройством /dev/sdb
2. var i:Longint; максимум=32768 (16Гб)

[Alex2013]

1 Флешки обычно размечают в Fat32 (или ExtFat)
2 "Второй упор" возможно связан с типом переменной i ( нужен Cardinal или int64)

1. Работаю с флешкой как с устройством /dev/sdb
2. var i:Longint; максимум=32768 (16Гб)

Еще одна возможная причина:
BlockRead и BlockWrite это легаси функции так что возможно что их просто никто не проверял на работу с большими файлами в современных ОС. Так что попробуй работать через TFileSteam
Простейший способ.

Код: Выделить всё

function CopyFile(src,dst:string):boolean;
var
     _src:TSream;  // Поток
     _dst:TStream;
begin
     try
         _src:=TFileStream.create(src); // создаем файловый поток по указанному имени исходного файла
         _dst:=TFileStream.create(dst); // создаем файловый поток по указанному имени конечного файла
         _dst.copyfrom(_src); // копируем поток
         _src.free; // очищаем все за собой
         _dst.free; // и это тоже....
         Copyfile:=true;
      // Если что то пошло не так то возвращаем неудачу!!!
       except
                  Copyfile:=false;
      end;
end;


Копирование "По блокам "

Код: Выделить всё

procedure FileCopy(aInFile, aOutFile: string; StartPos:int64; Len:int64);
const
  BuffSize = 100000;
var
  Buff: array [1 .. BuffSize] of Byte;
  InFile, OutFile: TFileStream;
begin

InFile  := TFileStream.Create(aInFile, fmOpenRead);
InFile.Seek(pos, soFromBeginning);

OutFile := TFileStream.Create(aOutFile, fmCreate or fmOpenWrite);

while InFile.Position < (pos+LEN) do
begin
    InFile.ReadBuffer(Buff, BuffSize);
    OutFile.WriteBuffer(Buff, BuffSize);
end;

   FreeAndNil(InFile);
   FreeAndNil(OutFile);
end;


Ну и ещё есть функция CopyFile

Код: Выделить всё

uses ..., FileUtils;

// 1st_variant
function CopyFile(const SrcFilename: String;const DestFilename: String):Boolean;

// 2nd_variant
function CopyFile(const SrcFilename: String;const DestFilename: String;PreserveTime: Boolean):Boolean;



Добавлено спустя 11 минут 59 секунд:
Более продвинутый код для копирования через BlockRead и BlockWrite

Код: Выделить всё

Function FileCopy(SFileName,DFileName : Shortstring;Var n : byte) : Integer;
Const
  BufSize = 65536;

Type
  TBuf = array [1..65536] of byte;
  PTBuf = ^TBuf;
Var
  i,ii : Longint;
  buf  : PTBuf;
  SFile ,
  DFile : File of Byte;
  FSize : Longint;
  IOR   : integer;
  FTime : Longint;
begin
  FileCopy := 0;
  N := 0;
  Assign(SFile,SFileName);
  {$i-}
  reset(SFile,1);
  {$i+}
  IOR := IOResult;
  if IOR <> 0 Then
    begin
      FileCopy := IOR;
      N := 1;
      exit
    end;
  assign(DFile,DFileName);
  if Not Exist_File(DFileName) then
    begin
      {$i-}
      rewrite(DFile,1)
      {$i+}
    end
                           else
    begin
      {$i-}
      reset(DFile,1);
      truncate(DFile)
      {$i+}
    end;
  IOR := IOResult;
  if IOR <> 0 Then
    begin
      FileCopy := IOR;
      N := 2;
      exit
    end;
  New(Buf);
  for i := 1 to FileSize(SFile) div BufSize do
    Begin
      BlockRead(SFile,Buf^,BufSize);
      BlockWrite(DFile,Buf^,BufSize)
    end;
  ii := FileSize(SFile) mod BufSize;
  if ii <> 0 Then
    Begin
      BlockRead(SFile,Buf^,ii);
      BlockWrite(DFile,Buf^,ii)
    end;
  Dispose(Buf);
  GetFTime(SFile,FTime);
  SetFTime(DFile,FTime);
  Close(SFile);
  Close(DFile);
end;


Хотя возможно хватит и этого

Код: Выделить всё

procedure TForm1.Button2Click(Sender: TObject);
const
  Fn1 = 'file1.dat';
  Fn2 = 'file2.dat';
  Size = 100000;
var
  F1, F2 : File;
  Buff : array[1..Size] of Byte;
  Cnt : Integer;
begin
  AssignFile(F1, Fn1);
  Reset(F1, 1);
  AssignFile(F2, Fn2);
  Rewrite(F2, 1);

  while not Eof(F1) do begin
    BlockRead(F1, Buff, Size, Cnt);
    BlockWrite(F2, Buff, Cnt);
  end;

  CloseFile(F1);
  CloseFile(F2);
end;



[Владимир]

BlockRead и BlockWrite это легаси функции так что возможно что их просто никто не проверял на работу с большими файлами в современных ОС.

Причем здесь "большие файлы", если BlockWrite=512 kb?
CopyFile и Stream требуют имена файлов, а у меня - устройство /dev/sdb нужно скопировать в файл.

Более продвинутый код для копирования через BlockRead и BlockWrite

Это попробую, спасибо!

[Alex2013]

Причем здесь "большие файлы", если BlockWrite=512 kb?

Какая разница если вы пишете гигабайты ?

CopyFile и Stream требуют имена файлов, а у меня - устройство /dev/sdb нужно скопировать в файл.

Оу ! Понятно неучел . Но TStream в принципе универсальный так что наверное можно и к /dev/sdb получить доступ.

[Владимир]

Хотя возможно хватит и этого

Не работает, создает файл 0-й длины, И да, cnt=???

[Alex2013]

Хотя возможно хватит и этого

Не работает, создает файл 0-й длины, И да, cnt=???

Хм ! А как инициализируется файловая переменная ? Просто AssignFile или как-то иначе ?

Добавлено спустя 4 минуты 30 секунд:
Еще одни "загадочный код" ( и насколько я понимаю более низкоуровневый )

Код: Выделить всё

Uses
OldLinux;
function copyfile(name1, name2: string):integer;
const
BUFSIZE=512;
PERM=0644;
var
infile, outfile: integer;
nread: longint;
buffer: array [0..BUFSIZE-1] of byte;
begin

infile := fdopen (name1, Open_RDONLY);
if infile=-1 then
begin
   copyfile:=-1;
   exit;
end;

outfile := fdopen (name2, Open_WRONLY or Open_CREAT or Open_TRUNC, octal(PERM));
if outfile=-1 then
begin
   fdclose(infile);
   copyfile:=-2;
   exit;
end;

nread := fdread (infile, buffer, BUFSIZE);
while nread > 0 do
begin

   if fdwrite (outfile, buffer, nread) < nread then
   begin
     fdclose (infile);
     fdclose (outfile);
     copyfile:=-3;
     exit;
   end;
   nread := fdread (infile, buffer, BUFSIZE);
end;

fdclose (infile);
fdclose (outfile);

if (nread = -1) then
   copyfile := -4
else
   copyfile := 0;
end;   


Добавлено спустя 6 минут 10 секунд:

И да, cnt=???

Cnt - это сколько байт реально прочитал BlockRead ( если файл кончился точно посредине блока то там будет Size / 2 )

[Владимир]

Хм ! А как инициализируется файловая переменная ? Просто AssignFile или как-то иначе ?

Вот код

Код: Выделить всё

function TForm1.DD_Work(FiName, FoName: String; BlockSize, Count: LongInt): LongInt;
var
  Fi: File;    //флешку в файл или наоборот                             //=2048
  Fo: File;
  Bf: array of Byte;
  Sz, Wr, Cn, i: LongInt;
  ps:LongInt;//Integer;
begin
// Bf:=0;
ps:=24;//48; //каждые 48 блоков - пауза и sync
PanProgr.Width:=24;
PAnBase.Visible:=True;
LabProcName.Visible:=TRue;
  SetLength(Bf, BlockSize);
  AssignFile(Fi, FiName);
  AssignFile(Fo, FoName);
  Reset(Fi, 1);//откр для чтения
  Rewrite(Fo, 1); //откр для записи
  Cn := 0; Sz := 0; Wr := 0;
  for i := 1 to Count do begin
    BlockRead (Fi, Bf[0], BlockSize, Sz); //читаем блок из файла

    if Sz = 0   then break; //кончилось чтение
    BlockWrite(Fo, Bf[0], Sz,     Wr); //пишем блок

   if i=ps then begin

   ps:=ps+24;//48;//каждые 48 Count
   sleep(slp);            //проб 1000
    fpSystem('sync');
    end;

   if Sz <> Wr then break;
    inc(Cn, Wr); //увелич Cn на Wr - считаем общее кол-во записанных байт
  end; //for
  CloseFile(Fo);
  CloseFile(Fi);
  Result := Cn;//общее число счит-записанных байт
end;

[Alex2013]

Если все идет чрез AssignFile и TFileSteam по идее будет работать .
(Он даже URL из интернета почти свободно кушает )

[Владимир]

Если все идет чрез AssignFile и TFileSteam по идее будет работать

Stream работает где-то до 2,1 Гб, потом валится...

[Alex2013]

Stream работает где-то до 2,1 Гб, потом валится...

Хм, это уже что-то линуксойдное, в винде вроде наоборот Stream надежнее .
Зы
Еще могут быть проблемы 32-битной версией ( в 64-разрядном Линуксе вообще с этми черт ногу сломит )
Зы Зы
А что с OldLinux примером ?

[Владимир]

Stream работает где-то до 2,1 Гб, потом валится...

Хм, это уже что-то линуксойдное, в винде вроде наоборот Stream надежнее .
Зы
Еще могут быть проблемы 32-битной версией ( в 64-разрядном Линуксе вообще с этми черт ногу сломит )
Зы Зы
А что с OldLinux примером ?

Не компилится.
Lin у меня 64

[Alex2013]

Lin у меня 64

А Лазарус (и ФПС) какие ? (В части 64-х разрядных дистрибутивов можно запускать 32-х разрядные приложения в части нет )

[Владимир]

Лазарус (и ФПС) какие ?

Laz 2.2.4, FPC 3.