[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