[fpc-pascal] CopyFile for FreePascal without Lazarus?
Graeme Geldenhuys
mailinglists at geldenhuys.co.uk
Thu Apr 18 15:51:33 CEST 2019
On 18/04/2019 12:04, James Richters wrote:
> How would I use this LazUtils Package with just FPC?
And with all that discussion and time gone by, you could have simply
implemented it yourself using TFileStream or something like that.
eg:
const
cBlockSize=16384; // size of block if copyfile
function CopyFile(const sSrc, sDst: String; bAppend: Boolean): Boolean;
var
src: TFileStream = nil;
dst: TFileStream = nil;
iDstBeg:Integer; // in the append mode we store original size
Buffer: PChar = nil;
begin
Result:=False;
if not FileExists(sSrc) then
Exit; //==>
GetMem(Buffer,cBlockSize+1);
try
try
src:=TFileStream.Create(sSrc,fmOpenRead or fmShareDenyNone);
if not Assigned(src) then
Exit;
if bAppend then
begin
dst:=TFileStream.Create(sDst,fmOpenReadWrite);
dst.Seek(0,soFromEnd); // seek to end
end
else
dst:=TFileStream.Create(sDst,fmCreate);
if not Assigned(dst) then
Exit;
iDstBeg:=dst.Size;
// we dont't use CopyFrom, because it's alocate and free buffer
every time is called
while (dst.Size+cBlockSize)<= (src.Size+iDstBeg) do
begin
Src.ReadBuffer(Buffer^, cBlockSize);
dst.WriteBuffer(Buffer^, cBlockSize);
end;
if (iDstBeg+src.Size)>dst.Size then
begin
src.ReadBuffer(Buffer^, src.Size+iDstBeg-dst.size);
dst.WriteBuffer(Buffer^, src.Size+iDstBeg-dst.size);
end;
// unix only - if we want to copy file attributes and permissions
// Result := FileCopyAttr(sSrc, sDst, gDropReadOnlyFlag); // chmod,
chgrp
except
on EStreamError do
TfpgMessageDialog.Critical('Error', Format('Cannot copy file
<%s> to <%s>' , [sSrc, sDst]));
end;
finally
if assigned(src) then
FreeAndNil(src);
if assigned(dst) then
FreeAndNil(dst);
if assigned(Buffer) then
FreeMem(Buffer);
end;
end;
Regards,
Graeme
More information about the fpc-pascal
mailing list