[Back to FILES SWAG index] [Back to Main SWAG index] [Original]

    {This way uses a File stream.}
    Procedure FileCopy( Const sourcefilename, targetfilename: String );
    Var
      S, T: TFileStream;
    Begin
      S := TFileStream.Create( sourcefilename, fmOpenRead );
      try
        T := TFileStream.Create( targetfilename, fmOpenWrite or fmCreate );
        try
          T.CopyFrom(S, S.Size ) ;
        finally
          T.Free;
        end;
      finally
        S.Free;
      end;
    End;

    {Here is one that uses a TMemoryStream:}
    procedure FileCopy(const FromFile, ToFile: string);
    begin
      with TMemoryStream.Create do
      try
        LoadFromFile(FromFile);

        SaveToFile(ToFile);
      finally
        Free;
      end;
    end;

    {This way uses memory blocks for read/write.}
    procedure FileCopy(const FromFile, ToFile: string);
     var
      FromF, ToF: file;
      NumRead, NumWritten: Word;
      Buf: array[1..2048] of Char;
    begin
      AssignFile(FromF, FromFile);
      Reset(FromF, 1);		{ Record size = 1 }
      AssignFile(ToF, ToFile);	{ Open output file }
      Rewrite(ToF, 1);		{ Record size = 1 }
      repeat
        BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (NumWritten <> NumRead);

      System.CloseFile(FromF);
      System.CloseFile(ToF);
    end;

    {This one uses LZCopy, which USES LZExpand.}
    procedure CopyFile(FromFileName, ToFileName: string);
    var
      FromFile, ToFile: File;
    begin
      AssignFile(FromFile, FromFileName); { Assign FromFile to FromFileName }
      AssignFile(ToFile, ToFileName);     { Assign ToFile to ToFileName }
      Reset(FromFile);                    { Open file for input }
      try
        Rewrite(ToFile);                  { Create file for output }
        try
          { copy the file an if a negative value is returned raise an exception }

          if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0 then
            raise Exception.Create('Error using LZCopy')
        finally
          CloseFile(ToFile);  { Close ToFile }
        end;
      finally
        CloseFile(FromFile);  { Close FromFile }
      end;
    end;

    This one is from Dr. Bob (Swart).  The point of this one is that it contains a callback function that gives you the ability to callback.  This can be used for progress bars and the like.  Groetjes, Dr. Bob!

     {$A+,B-,D-,F-,G+,I+,K+,L-,N+,P+,Q-,R-,S+,T+,V-,W-,X+,Y-}
     unit FileCopy;

     (*
       FILECOPY 1.5 (Public Domain)
       Borland Delphi 1.0
       Copr. (c) 1995-08-27 Robert E. Swart (100434.2072@compuserve.com)
                            P.O. box 799
                            5702 NP  Helmond
                            The Netherlands
       -----------------------------------------------------------------
       This unit implements a FastFileCopy procedure that is usable from
       Borland Pascal (real mode, DPMI or Windows) and Borland Delphi. A
       callback routine (or nil) can be given as extra argument.

       Example of usage:

       {$IFDEF WINDOWS}
        uses FileCopy, WinCrt;
       {$ELSE}
        uses FileCopy, Crt;

       {$ENDIF}

          procedure CallBack(Position, Size: LongInt); far;
          var i: Integer;
          begin
            { do you stuff here... }
            GotoXY(1,1);
            for i:=1 to (80 * Position) div Size do write('X')
          end {CallBack};

        begin
          FastFileCopy('C:\AUTOEXEC.BAT', 'C:\AUTOEXEC.BAK', nil);
          FastFileCopy('C:\CONFIG.SYS', 'C:\CONFIG.BAK', CallBack)
        end.
     *)
     interface

     Type
       TCallBack = procedure (Position, Size: LongInt); { export; }

       procedure FastFileCopy(Const InFileName, OutFileName: String;
                              CallBack: TCallBack);

     implementation
     {$IFDEF VER80}
     uses SysUtils;
     {$ELSE}
       {$IFDEF WINDOWS}
       uses WinDos;
       {$ELSE}
       uses Dos;
       {$ENDIF}
     {$ENDIF}

       procedure FastFileCopy(Const InFileName, OutFileName: String;
                              CallBack: TCallBack);
       Const BufSize = 8*4096; { 32Kbytes gives me the best results }
       Type
         PBuffer = ^TBuffer;
         TBuffer = Array[1..BufSize] of Byte;
       var Size: Word;
           Buffer: PBuffer;
           infile,outfile: File;
           SizeDone,SizeFile,TimeDateFile: LongInt;
       begin
         if (InFileName <> OutFileName) then
         begin
           Buffer := nil;
           Assign(infile,InFileName);

           System.Reset(infile,1);
           {$IFDEF VER80}
           try
           {$ELSE}
           begin
           {$ENDIF}
             SizeFile := FileSize(infile);
             Assign(outfile,OutFileName);
             System.Rewrite(outfile,1);
             {$IFDEF VER80}
             try
             {$ELSE}
             begin
             {$ENDIF}
               SizeDone := 0;
               New(Buffer);
               repeat
                 BlockRead(infile,Buffer^,BufSize,Size);
                 Inc(SizeDone,Size);
                 if (@CallBack <> nil) then
                   CallBack(SizeDone,SizeFile);

                 BlockWrite(outfile,Buffer^,Size)
               until Size < BufSize;
               {$IFDEF VER80}
               FileSetDate(TFileRec(outfile).Handle,
                 FileGetDate(TFileRec(infile).Handle));
               {$ELSE}
               GetFTime(infile, TimeDateFile);
               SetFTime(outfile, TimeDateFile);
               {$ENDIF}
             {$IFDEF VER80}
             finally
             {$ENDIF}
               if Buffer <> nil then Dispose(Buffer);
               System.close(outfile)
             end;
           {$IFDEF VER80}
           finally
           {$ENDIF}

             System.close(infile)
           end
         end
         {$IFDEF VER80}
         else
           Raise EInOutError.Create('File cannot be copied onto itself')
         {$ENDIF}
       end {FastFileCopy};
     end.

[Back to FILES SWAG index] [Back to Main SWAG index] [Original]