Home page > Delphi, tips bulk > Miscellaneous > CopyStreamFileSegment: copying segments of streams or files
CopyStreamFileSegment: copying segments of streams or files

Sunday 18 September 2011, by CapJack
This unit is used to copy segments of streams/files, or in a destination open stream/file, which content will be modified, or in a new file.
Compatible with Delphi/Lazarus all versions, all platforms.
I’m not asking anything in return for this work, except a small link to my site if you find it useful and use it in your software.
CapJack.
Download the source code below
(*********************************************************)
(***)                                                 (***)
(***)          UNIT CopyStreamFileSegment;            (***)
(***)                                                 (***)
(*********************************************************)
 
(*********************************************************)
(* Feel free to use it, but at your own risk!            *)
(* À utiliser librement, mais à vos risques et périls !  *)
(* CapJack.                                              *)
(*********************************************************)
 
 
(*********************************************************)
(***)                                                 (***)
(***)                  INTERFACE                      (***)
(***)                                                 (***)
(*********************************************************)
 
uses Classes;
 
 
const     CSFSDefBufSize = 64*1024;
 
type      CSFSFileProgress
           = procedure(const Pos:Int64) of object;
 
(*********************************************************)
(* DTCopyStreamSegment                                   *)
(* ----------------------------------------------------- *)
(* Copy a segment of stream in another stream            *)
(* AStream1     : source stream                          *)
(* AnOffset1    : offset of data to copy                 *)
(* AStream2     : destination stream                     *)
(* AnOffset2    : destination address                    *)
(* ALength      : length to copy (zero -> maximum)       *)
(* AnOnProgress : progress callback event                *)
(* ABufferSize  : buffer size to use                     *)
(* ----------------------------------------------------- *)
(* Copie un segment de flux dans un autre flux           *)
(* AStream1     : flux source                            *)
(* AnOffset1    : adresse des données à copier           *)
(* AStream2     : flux de destination                    *)
(* AnOffset2    : adresse de destination                 *)
(* ALength      : longueur à copier  (zéro -> maximum)   *)
(* AnOnProgress : évènement de progression en retour     *)
(* ABufferSize  : taille de buffer à utiliser            *)
(*********************************************************)
 
procedure DTCopyStreamSegment
        (
        const AStream1          : TStream;
        const AnOffset1         : Int64;
        const AStream2          : TStream;
        const AnOffset2         : Int64;
        const ALength           : Int64;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
 
(*********************************************************)
(* DTCopyFileSegment                                     *)
(* ----------------------------------------------------- *)
(* Copy a segment of file in another file                *)
(* AFileName1   : source file name                       *)
(* AnOffset1    : offset of data to copy                 *)
(* AFileName2   : destination file name                  *)
(* AnOffset2    : destination address                    *)
(* ALength      : length to copy (zero -> maximum)       *)
(* AnOnProgress : progress callback event                *)
(* ABufferSize  : buffer size to use                     *)
(* ----------------------------------------------------- *)
(* Copie un segment de fichier dans un fichier existant  *)
(* AFileName1   : nom du fichier source                  *)
(* AnOffset1    : adresse des données a copier           *)
(* AFileName2   : nom du fichier de destination          *)
(* AnOffset2    : adresse de destination                 *)
(* ALength      : longueur à copier  (zéro -> maximum)   *)
(* AnOnProgress : évènement de progression en retour     *)
(* ABufferSize  : taille de buffer à utiliser            *)
(*********************************************************)
 
procedure DTCopyFileSegment
        (
        const AFileName1        : string;
        const AnOffset1         : Int64;
        const AFileName2        : string;
        const AnOffset2         : Int64;
        const ALength           : Int64;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
 
(*********************************************************)
(* DTCopyStreamSegToNewFile                              *)
(* ----------------------------------------------------- *)
(* Copy a segment of stream in a new file                *)
(* AStream      : source stream                          *)
(* AnOffset     : offset of data to copy                 *)
(* ALength      : length to copy (zero -> maximum)       *)
(* AFileName    : destination name of file to create     *)
(* AnOnProgress : progress callback event                *)
(* ABufferSize  : buffer size to use                     *)
(* ----------------------------------------------------- *)
(* Copie un segment de flux dans un nouveau fichier      *)
(* AStream      : flux source                            *)
(* AnOffset     : adresse des données à copier           *)
(* ALength      : longueur à copier  (zéro -> maximum)   *)
(* AFileName    : nom du fichier de destination à créer  *)
(* AnOnProgress : évènement de progression en retour     *)
(* ABufferSize  : taille de buffer à utiliser            *)
(*********************************************************)
 
Procedure DTCopyStreamSegToNewFile
        (
        const AStream           : TStream;
        const AnOffset          : Int64;
        const ALength           : Int64;
        const AFileName         : string;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
 
(*********************************************************)
(* DTCopyFileSegToNewFile                                *)
(* ----------------------------------------------------- *)
(* Copy a segment of file in a new file                  *)
(* AFileName1   : source file name                       *)
(* AnOffset     : offset of data to copy                 *)
(* ALength      : length to copy (zero -> maximum)       *)
(* AFileName2   : destination name of file to create     *)
(* AnOnProgress : progress callback event                *)
(* ABufferSize  : buffer size to use                     *)
(* ----------------------------------------------------- *)
(* Copie un segment de fichier dans un nouveau fichier   *)
(* AFileName1   : fichier source                         *)
(* AnOffset     : adresse des données à copier           *)
(* ALength      : longueur à copier  (zéro -> maximum)   *)
(* AFileName2   : nom du fichier de destination à créer  *)
(* AnOnProgress : évènement de progression en retour     *)
(* ABufferSize  : taille de buffer à utiliser            *)
(*********************************************************)
 
Procedure DTCopyFileSegToNewFile
        (
        const AFileName1        : string;
        const AnOffset          : Int64;
        const ALength           : Int64;
        const AFileName2        : string;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
 
 
(*********************************************************)
(***)                                                 (***)
(***)                 IMPLEMENTATION                  (***)
(***)                                                 (***)
(*********************************************************)
 
uses SysUtils;
 
{---------------------------------------------------------}
 
procedure DTCopyStreamSegment
        (
        const AStream1          : TStream;
        const AnOffset1         : Int64;
        const AStream2          : TStream;
        const AnOffset2         : Int64;
        const ALength           : Int64;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
var TotalRemaining,BufferToConsider:Int64;
    Offset1,Offset2,Length:Int64;
    Buffer:PByte;
 begin
  if AnOffset1 < 0
     then Offset1 := 0
     else Offset1 := AnOffset1;
  if AnOffset2 < 0
     then Offset2 := 0
     else Offset2 := AnOffset2;;
  if ALength > 0
     then Length := ALength
     else Length := AStream1.Size-Offset1;
  Buffer:=nil;
  try
   AStream1.Seek(Offset1,soFromBeginning);
   AStream2.Seek(Offset2,soFromBeginning);
   GetMem(Buffer,ABufferSize);
   TotalRemaining:=Length;
   repeat
    if assigned(AnOnProgress)
       then AnOnProgress(Length-TotalRemaining);
     if TotalRemaining > ABufferSize
        then BufferToConsider := ABufferSize
        else BufferToConsider := TotalRemaining;
     AStream1.ReadBuffer(Buffer^,BufferToConsider);
     AStream2.WriteBuffer(Buffer^,BufferToConsider);
     Dec(TotalRemaining,BufferToConsider);
   until (TotalRemaining = 0)
  finally
   if assigned(Buffer) then FreeMem(Buffer);
  end;
  if assigned(AnOnProgress)
     then AnOnProgress(Length-TotalRemaining);
 end;
 
{---------------------------------------------------------}
 
procedure DTCopyFileSegment
        (
        const AFileName1        : string;
        const AnOffset1         : Int64;
        const AFileName2        : string;
        const AnOffset2         : Int64;
        const ALength           : Int64;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
var Stream1,Stream2:TFileStream;
begin
  Stream1:=nil;
  Stream2:=nil;
  try
   Stream1 := TFileStream.Create
              (AFileName1,fmOpenRead or fmShareDenyWrite);
   Stream2 := TFileStream.Create
              (AFileName2,fmOpenReadWrite or fmShareExclusive);
   DTCopyStreamSegment(Stream1,AnOffset1,Stream2,AnOffset2,
                       ALength,AnOnProgress,ABufferSize);
  finally
   if assigned(Stream1) then Stream1.Free;
   if assigned(Stream2) then Stream2.Free;
  end;
 end;
 
{---------------------------------------------------------}
 
Procedure DTCopyStreamSegToNewFile
        (
        const AStream           : TStream;
        const AnOffset          : Int64;
        const ALength           : Int64;
        const AFileName         : string;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
var StreamDest:TFileStream;
begin
  StreamDest:=nil;
  try
   StreamDest := TFileStream.Create
                 (AFileName,fmCreate or fmShareExclusive);
   DTCopyStreamSegment(AStream,AnOffset,StreamDest,0,
                       ALength,AnOnProgress,ABufferSize);
  finally
   if assigned(StreamDest) then StreamDest.Free;
  end;
 end;
 
{---------------------------------------------------------}
 
Procedure DTCopyFileSegToNewFile
        (
        const AFileName1        : string;
        const AnOffset          : Int64;
        const ALength           : Int64;
        const AFileName2        : string;
        const AnOnProgress      : CSFSFileProgress = nil;
        const ABufferSize       : Int64 = CSFSDefBufSize
        );
var Stream1,Stream2:TFileStream;
begin
  Stream1:=nil;
  Stream2:=nil;
  try
   Stream1 := TFileStream.Create
              (AFileName1,fmOpenRead or fmShareDenyWrite);
   Stream2 := TFileStream.Create
              (AFileName2,fmCreate or fmShareExclusive);
   DTCopyStreamSegment(Stream1,AnOffset,Stream2,0,
                       ALength,AnOnProgress,ABufferSize);
  finally
   if assigned(Stream1) then Stream1.Free;
   if assigned(Stream2) then Stream2.Free;
  end;
 end;
 
{---------------------------------------------------------}
 
end.
CopyStreamFileSegment: copying segments of streams or files

Sections

In the same section
