[roamer]

Несколько возможных вариантов (попадались в разные времена в разных местах).

Код:

function CopyFile0(fnFrom,fnTo : String): Boolean;
Const
  RecS = 32768;
Var
  Ok99 : Boolean;
  F1,F2 : file;
  NumRead, NumWritten: Integer; 
  Buf : array[1..RecS] of byte;
  i : word;
begin
  Result:=FALSE;
  fnFrom:=Trim(fnFrom);
  fnTo:=Trim(fnTo);
  if (length(fnFrom)>0) and (length(fnTo)>0) then begin
     if AnsiUpperCase(fnFrom)<>AnsiUpperCase(fnTo) then begin
        AssignFile(F1,fnFrom);
        FileMode := 0;
        {$I-} reset(F1,1) {$I+};
        Ok99:=(IoResult=0);
        TRY                
           if Ok99 then begin
              TRY
                AssignFile(F2,fnTo);
                FileMode := 2;
                rewrite(F2,1);
                repeat
                  BlockRead(F1, Buf, SizeOf(Buf), NumRead);
                  BlockWrite(F2, Buf, NumRead, NumWritten);
                until (NumRead = 0) or (NumWritten <> NumRead);
                Result:=TRUE;
              FINALLY
                {$I-} CloseFile(F2) {$I+};
                Ok99:=(IoResult=0);
              END;
           end;
        FINALLY
          {$I-} CloseFile(F1) {$I+};
          Ok99:=(IoResult=0);
        END;
     end;
  end;
end;
    

function CopyFile1(fnFrom, fnTo : String;NotRewrite : BOOLEAN): Boolean;
Var
  Err : LongInt;
  cFrom,cTo : array[0..1023] of Char;
begin
  Result:=FALSE;
  fnFrom:=trim(fnFrom);
  fnTo:=trim(fnTo);
  if (length(fnFrom)>0) and (length(fnTo)>0) then begin
     if AnsiUpperCase(fnFrom)<>AnsiUpperCase(fnTo) then begin
        StrPCopy(cFrom,fnFrom);
        StrPCopy(cTo,fnTo);
        if WinProcs.CopyFile(cFrom,cTo,NotRewrite) then begin
           Result:=TRUE;
        end
        else begin
           Err:=GetLastError;
        end;
     end;            
  end;            
end;


function CopyFile2(fnFrom, DirTo : string) : boolean;
//Если каталога DirTo не существует, Windows выдаст запрос на его создание
var
  F : TShFileOpStruct;
begin
  Result:=false;                              
  fnFrom:=Trim(fnFrom);
  if length(fnFrom)>0 then begin                                                         
     DirTo:=Trim(DirTo);
     F.Wnd := 0;
     F.wFunc := FO_COPY;
     fnFrom:=fnFrom+#0;
     F.pFrom:=pchar(fnFrom);
     DirTo:=DirTo+#0;
     F.pTo:=pchar(DirTo);
     F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
     Result:=ShFileOperation(F) = 0;
  end;
end;

                                        

//Этот вариант был в режиме проверки.
//Не помню - довел его до ума или нет.                                                                                      
function CopyFile3(fnFrom, fnTo : string) : boolean;
var
  FromFile, ToFile: File;
  Ok99 : boolean;
begin
  Result:=FALSE;
  fnFrom:=Trim(fnFrom);
  fnTo:=Trim(fnTo);
  if (length(fnFrom)>0) and (length(fnTo)>0) then begin
     if AnsiUpperCase(fnFrom)<>AnsiUpperCase(fnTo) then begin
        AssignFile(FromFile, fnFrom);
        AssignFile(ToFile, fnTo);
        {$I-} Reset(FromFile) {$I+};
        Ok99:=(IoResult=0);
        try
          Rewrite(ToFile);
          try
            if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle)<0 then begin
               //raise Exception.Create('Error using LZCopy');
            end
            else begin
               Result:=TRUE;
            end;
          finally
            {$I-} CloseFile(ToFile) {$I+};
            Ok99:=(IoResult=0);
          end;
        finally
          {$I-} CloseFile(FromFile) {$I+};
          Ok99:=(IoResult=0);
        end;
     end;
  end;
end;