Модератор: Модераторы
Код: Выделить всё
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;
1. Работаю с флешкой как с устройством /dev/sdbAlex2013 писал(а):1 Флешки обычно размечают в Fat32 (или ExtFat)
2 "Второй упор" возможно связан с типом переменной i ( нужен Cardinal или int64)
Еще одна возможная причина:Владимир писал(а):1. Работаю с флешкой как с устройством /dev/sdbAlex2013 писал(а):1 Флешки обычно размечают в Fat32 (или ExtFat)
2 "Второй упор" возможно связан с типом переменной i ( нужен Cardinal или int64)
2. var i:Longint; максимум=32768 (16Гб)
Код: Выделить всё
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;
Код: Выделить всё
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;
Код: Выделить всё
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;
Причем здесь "большие файлы", если BlockWrite=512 kb?Alex2013 писал(а):BlockRead и BlockWrite это легаси функции так что возможно что их просто никто не проверял на работу с большими файлами в современных ОС.
Это попробую, спасибо!Alex2013 писал(а):Более продвинутый код для копирования через BlockRead и BlockWrite
Какая разница если вы пишете гигабайты ?Владимир писал(а): Причем здесь "большие файлы", если BlockWrite=512 kb?
CopyFile и Stream требуют имена файлов, а у меня - устройство /dev/sdb нужно скопировать в файл.
Не работает, создает файл 0-й длины, И да, cnt=???Alex2013 писал(а):Хотя возможно хватит и этого
Хм ! А как инициализируется файловая переменная ? Просто AssignFile или как-то иначе ?Владимир писал(а):Не работает, создает файл 0-й длины, И да, cnt=???Alex2013 писал(а):Хотя возможно хватит и этого
Код: Выделить всё
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;
Cnt - это сколько байт реально прочитал BlockRead ( если файл кончился точно посредине блока то там будет Size / 2 )Владимир писал(а):И да, cnt=???
Вот кодAlex2013 писал(а):Хм ! А как инициализируется файловая переменная ? Просто 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;Stream работает где-то до 2,1 Гб, потом валится...Alex2013 писал(а):Если все идет чрез AssignFile и TFileSteam по идее будет работать
Хм, это уже что-то линуксойдное, в винде вроде наоборот Stream надежнее .Владимир писал(а):Stream работает где-то до 2,1 Гб, потом валится...
Не компилится.Alex2013 писал(а):Хм, это уже что-то линуксойдное, в винде вроде наоборот Stream надежнее .Владимир писал(а):Stream работает где-то до 2,1 Гб, потом валится...
Зы
Еще могут быть проблемы 32-битной версией ( в 64-разрядном Линуксе вообще с этми черт ногу сломит )
Зы Зы
А что с OldLinux примером ?
А Лазарус (и ФПС) какие ? (В части 64-х разрядных дистрибутивов можно запускать 32-х разрядные приложения в части нет )Владимир писал(а):Lin у меня 64
Laz 2.2.4, FPC 3.Alex2013 писал(а): Лазарус (и ФПС) какие ?