Chip 2003 January/ChipCD_1.03.iso/zkuste/delphi/unity/d56/FNDUTL.ZIP/Streams/cStreams.pas

Pascal/Delphi Source File | 2002-10-29 | 25.2 KB | 757 lines

{$INCLUDE ..\cDefines.inc}
unit cStreams;

{                                                                              }
{                               Streams v3.07                                  }
{                                                                              }
{      This unit is copyright ⌐ 1999-2002 by David Butler ([e-mail])      }
{                                                                              }
{                  This unit is part of Delphi Fundamentals.                   }
{                   Its original file name is cStreams.pas                     }
{       The latest version is available from the Fundamentals home page        }
{                     http://fundementals.sourceforge.net/                     }
{                                                                              }
{                I invite you to use this unit, free of charge.                }
{        I invite you to distibute this unit, but it must be for free.         }
{             I also invite you to contribute to its development,              }
{             but do not distribute a modified copy of this file.              }
{                                                                              }
{          A forum is available on SourceForge for general discussion          }
{             http://sourceforge.net/forum/forum.php?forum_id=2117             }
{                                                                              }
{                                                                              }
{ Revision history:                                                            }
{   01/03/1999  0.01  Initial version.                                         }
{   08/02/2000  1.02  AStreamEx.                                               }
{   08/05/2000  1.03  ATRecordStream.                                          }
{   01/06/2000  1.04  TFixedLenRecordStreamer.                                 }
{   29/05/2002  3.05  Created cReaders and cWriters units from cStreams.       }
{   03/08/2002  3.06  Moved TVarSizeAllocator to unit cVarAllocator.           }
{   18/08/2002  3.07  Added TReaderWriter as AStream.                          }
{                                                                              }

interface

uses
  // Delphi
  SysUtils,

  // Fundamentals
  cReaders,
  cWriters;



{                                                                              }
{ AStream                                                                      }
{   Abstract base class for streams.                                           }
{                                                                              }
type
  AStream = class;
  AStreamCopyProgressEvent = Procedure (const Source, Destination : AStream;
      const BytesCopied : Int64; var Abort : Boolean) of object;
  AStream = class
    protected
    FOnCopyProgress : AStreamCopyProgressEvent;

    Function  GetPosition : Int64; virtual; abstract;
    Procedure SetPosition (const Position : Int64); virtual; abstract;
    Function  GetSize : Int64; virtual; abstract;
    Procedure SetSize (const Size : Int64); virtual; abstract;
    Function  GetReader : AReaderEx; virtual; abstract;
    Function  GetWriter : AWriterEx; virtual; abstract;

    Procedure TriggerCopyProgressEvent (const Source, Destination : AStream;
              const BytesCopied : Int64; var Abort : Boolean); virtual;

    public
    Function  Read (var Buffer; const Size : Integer) : Integer; virtual; abstract;
    Function  Write (const Buffer; const Size : Integer) : Integer; virtual; abstract;

    Property  Position : Int64 read GetPosition write SetPosition;
    Property  Size : Int64 read GetSize write SetSize;
    Function  EOF : Boolean; virtual;

    Property  Reader : AReaderEx read GetReader;
    Property  Writer : AWriterEx read GetWriter;

    Procedure ReadBuffer (var Buffer; const Size : Integer);
    Function  ReadByte : Byte;
    Procedure WriteBuffer (const Buffer; const Size : Integer);
    Procedure WriteStr (const S : String);

    Procedure Assign (const Source : TObject); virtual;
    Function  WriteTo (const Destination : AStream; const BlockSize : Integer = 0;
              const Count : Int64 = -1) : Int64;

    Property  OnCopyProgress : AStreamCopyProgressEvent read FOnCopyProgress write FOnCopyProgress;
  end;
  EStream = class (Exception);
  EStreamOperationAborted = class (EStream)
    Constructor Create;
  end;



{                                                                              }
{ Stream proxies                                                               }
{                                                                              }
type
  { TStreamReaderProxy                                                         }
  TStreamReaderProxy = class (AReaderEx)
    protected
    FStream : AStream;

    Function  GetPosition : Int64; override;
    Procedure SetPosition (const Position : Int64); override;
    Function  GetSize : Int64; override;

    public
    Constructor Create (const Stream : AStream);
    Property  Stream : AStream read FStream;

    Function  Read (var Buffer; const Size : Integer) : Integer; override;
    Function  EOF : Boolean; override;
  end;

  { TStreamWriterProxy                                                         }
  TStreamWriterProxy = class (AWriterEx)
    protected
    FStream : AStream;

    Function  GetPosition : Int64; override;
    Procedure SetPosition (const Position : Int64); override;
    Function  GetSize : Int64; override;
    Procedure SetSize (const Size : Int64); override;

    public
    Constructor Create (const Stream : AStream);
    Property  Stream : AStream read FStream;

    Function  Write (const Buffer; const Size : Integer) : Integer; override;
  end;



{                                                                              }
{ Stream functions                                                             }
{                                                                              }
type
  TCopyProgressProcedure = Procedure (const Source, Destination : AStream;
      const BytesCopied : Int64; var Abort : Boolean);

Function  CopyStream (const Source, Destination : AStream;
          const SourceOffset : Int64 = 0; const DestinationOffset : Int64 = 0;
          const BlockSize : Integer = 0; const Count : Int64 = -1;
          const ProgressCallback : TCopyProgressProcedure = nil;
          const CopyFromBack : Boolean = False) : Int64; overload;

Function  CopyStream (const Source : AReaderEx; const Destination : AWriterEx;
          const BlockSize : Integer = 0) : Int64; overload;

Procedure DeleteStreamRange (const Stream : AStream; const Position, Count : Int64;
          const ProgressCallback : TCopyProgressProcedure = nil);
Procedure InsertStreamRange (const Stream : AStream; const Position, Count : Int64;
          const ProgressCallback : TCopyProgressProcedure = nil);

Procedure StreamDotLineTerminated (const Source : AStream;
          const Destination : AStream; const ProgressCallback : TCopyProgressProcedure = nil); overload;
Procedure StreamDotLineTerminated (const Source : String;
          const Destination : AStream; const ProgressCallback : TCopyProgressProcedure = nil); overload;



{                                                                              }
{ TReaderWriter                                                                }
{   Composition of a Reader and a Writer as a Stream.                          }
{                                                                              }
type
  TReaderWriter = class (AStream)
    protected
    FReader         : AReaderEx;
    FWriter         : AWriterEx;
    FReaderOwner    : Boolean;
    FWriterOwner    : Boolean;

    Procedure RaiseNoReaderError;
    Procedure RaiseNoWriterError;

    Function  GetPosition : Int64; override;
    Procedure SetPosition (const Position : Int64); override;
    Function  GetSize : Int64; override;
    Procedure SetSize (const Size : Int64); override;
    Function  GetReader : AReaderEx; override;
    Function  GetWriter : AWriterEx; override;

    public
    Constructor Create (const Reader : AReaderEx; const Writer : AWriterEx;
                const ReaderOwner : Boolean = True; const WriterOwner : Boolean = True);
    Destructor Destroy; override;

    Property  Reader : AReaderEx read FReader;
    Property  Writer : AWriterEx read FWriter;
    Property  ReaderOwner : Boolean read FReaderOwner write FReaderOwner;
    Property  WriterOwner : Boolean read FWriterOwner write FWriterOwner;

    Function  Read (var Buffer; const Size : Integer) : Integer; override;
    Function  Write (const Buffer; const Size : Integer) : Integer; override;
  end;
  EReaderWriter = class (Exception);



{                                                                              }
{ TFileStream                                                                  }
{   Stream implementation for a file.                                          }
{                                                                              }
type
  TFileStreamOpenMode = (fsomRead,
                         fsomReadWrite,
                         fsomCreate,
                         fsomCreateIfNotExist);
  TFileStream = class (TReaderWriter)
    protected
    FFileName : String;

    Procedure SetPosition (const Position : Int64); override;
    Function  GetFileHandle : Integer;
    Function  GetFileCreated : Boolean;

    public
    Constructor Create (const FileName : String;
                const OpenMode : TFileStreamOpenMode); overload;
    Constructor Create (const FileHandle : Integer; const HandleOwner : Boolean); overload;

    Property  FileName : String read FFileName;
    Property  FileHandle : Integer read GetFileHandle;
    Property  FileCreated : Boolean read GetFileCreated;
    Procedure DeleteFile;
  end;
  EFileStream = class (EStream);



{                                                                              }
{ Self-testing code                                                            }
{                                                                              }
Procedure SelfTest;



implementation

uses
  // Fundamentals
  cUtils,
  cStrings;



{                                                                              }
{ EStreamOperationAborted                                                      }
{                                                                              }
Constructor EStreamOperationAborted.Create;
  Begin
    inherited Create ('Stream operation aborted');
  End;



{                                                                              }
{ TStreamReaderProxy                                                           }
{                                                                              }
Constructor TStreamReaderProxy.Create (const Stream : AStream);
  Begin
    inherited Create;
    Assert (Assigned (Stream), 'Assigned (Stream)');
    FStream := Stream;
  End;

Function TStreamReaderProxy.GetPosition : Int64;
  Begin
    Result := FStream.Position;
  End;

Procedure TStreamReaderProxy.SetPosition (const Position : Int64);
  Begin
    FStream.Position := Position;
  End;

Function TStreamReaderProxy.GetSize : Int64;
  Begin
    Result := FStream.Size;
  End;

Function TStreamReaderProxy.Read (var Buffer; const Size : Integer) : Integer;
  Begin
    Result := FStream.Read (Buffer, Size)
  End;

Function TStreamReaderProxy.EOF : Boolean;
  Begin
    Result := FStream.EOF;
  End;



{                                                                              }
{ TStreamWriterProxy                                                           }
{                                                                              }
Constructor TStreamWriterProxy.Create (const Stream : AStream);
  Begin
    inherited Create;
    Assert (Assigned (Stream), 'Assigned (Stream)');
    FStream := Stream;
  End;

Function TStreamWriterProxy.GetPosition : Int64;
  Begin
    Result := FStream.Position;
  End;

Procedure TStreamWriterProxy.SetPosition (const Position : Int64);
  Begin
    FStream.Position := Position;
  End;

Function TStreamWriterProxy.GetSize : Int64;
  Begin
    Result := FStream.Size;
  End;

Procedure TStreamWriterProxy.SetSize (const Size : Int64);
  Begin
    FStream.Size := Size;
  End;

Function TStreamWriterProxy.Write (const Buffer; const Size : Integer) : Integer;
  Begin
    Result := FStream.Write (Buffer, Size)
  End;



{                                                                              }
{ CopyStream                                                                   }
{                                                                              }
const
  DefaultBlockSize = 2048;

Function CopyStream (const Source, Destination : AStream; const SourceOffset : Int64; const DestinationOffset : Int64; const BlockSize : Integer; const Count : Int64; const ProgressCallback : TCopyProgressProcedure; const CopyFromBack : Boolean) : Int64;
var Buf     : Pointer;
    L, I, C : Integer;
    R, S, D : Int64;
    A       : Boolean;
  Begin
    if not Assigned (Source) then
      raise EStream.Create ('Invalid source');
    if not Assigned (Destination) then
      raise EStream.Create ('Invalid destination');
    S := SourceOffset;
    D := DestinationOffset;
    if (S < 0) or (D < 0) then
      raise EStream.Create ('Invalid offset');
    if (Source = Destination) and (Count < 0) and (S < D) then
      raise EStream.Create ('Invalid parameters');
    A := False;
    if Assigned (ProgressCallback) then
      begin
        ProgressCallback (Source, Destination, 0, A);
        if A then
          raise EStreamOperationAborted.Create;
      end;
    Result := 0;
    R := Count;
    if R = 0 then
      exit;
    L := BlockSize;
    if L <= 0 then
      L := DefaultBlockSize;
    if (R > 0) and (R < L) then
      L := R;
    if CopyFromBack then
      begin
        if R < 0 then
          raise EStream.Create ('Invalid count');
        Inc (S, R - L);
        Inc (D, R - L);
      end;
    GetMem (Buf, L);
    try
      While not Source.EOF and (R <> 0) do
        begin
          C := L;
          if (R > 0) and (R < C) then
            C := R;
          Source.Position := S;
          I := Source.Read (Buf^, C);
          if (I <= 0) and not Source.EOF then
            raise EStream.Create ('Stream read error');
          Destination.Position := D;
          Destination.WriteBuffer (Buf^, I);
          Inc (Result, I);
          if R > 0 then
            Dec (R, I);
          if CopyFromBack then
            begin
              Dec (S, I);
              Dec (D, I);
            end else
            begin
              Inc (S, I);
              Inc (D, I);
            end;
          if Assigned (ProgressCallback) then
            begin
              ProgressCallback (Source, Destination, Result, A);
              if A then
                raise EStreamOperationAborted.Create;
            end;
        end;
    finally
      FreeMem (Buf);
    end;
  End;

Function CopyStream (const Source : AReaderEx; const Destination : AWriterEx; const BlockSize : Integer) : Int64;
var Buf  : Pointer;
    L, I : Integer;
  Begin
    if not Assigned (Source) then
      raise EStream.Create ('Invalid source');
    if not Assigned (Destination) then
      raise EStream.Create ('Invalid destination');
    L := BlockSize;
    if L <= 0 then
      L := DefaultBlockSize;
    Result := 0;
    GetMem (Buf, L);
    try
      While not Source.EOF do
        begin
          I := Source.Read (Buf^, L);
          if (I = 0) and not Source.EOF then
            Source.RaiseReadError;
          Destination.WriteBuffer (Buf^, I);
          Inc (Result, I);
        end;
    finally
      FreeMem (Buf);
    end;
  End;

Procedure DeleteStreamRange (const Stream : AStream; const Position, Count : Int64; const ProgressCallback : TCopyProgressProcedure);
  Begin
    if Count <= 0 then
      exit;
    if CopyStream (Stream, Stream, Stream.Position + Count, Stream.Position, 0, Count,
        ProgressCallback, False) <> Count then
      raise EStream.Create ('Copy error');
  End;

Procedure InsertStreamRange (const Stream : AStream; const Position, Count : Int64; const ProgressCallback : TCopyProgressProcedure);
  Begin
    if Count <= 0 then
      exit;
    if CopyStream (Stream, Stream, Stream.Position, Stream.Position + Count, 0, Count,
        ProgressCallback, True) <> Count then
      raise EStream.Create ('Copy error');
  End;

Procedure StreamDotLineTerminated (const Source : AStream; const Destination : AStream; const ProgressCallback : TCopyProgressProcedure);
var R : AReaderEx;
    W : AWriterEx;
    P : Int64;
    A : Boolean;
    S : String;
  Begin
    R := Source.Reader;
    W := Destination.Writer;
    P := R.Position;
    A := False;
    While not R.EOF do
      begin
        S := R.ExtractLine (-1, True);
        if (S <> '') and (S [1] = '.') then
          S := '.' + S;
        W.WriteLine (S, nlCRLF);
        if Assigned (ProgressCallback) then
          begin
            ProgressCallback (Source, Destination, R.Position - P, A);
            if A then
              raise EStreamOperationAborted.Create;
          end;
      end;
    W.WriteLine ('.', nlCRLF);
  End;

Procedure StreamDotLineTerminated (const Source : String; const Destination : AStream; const ProgressCallback : TCopyProgressProcedure);
var R : StringArray;
    W : AWriterEx;
    A : Boolean;
    S : String;
    I : Integer;
    P : Int64;
  Begin
    R := Split (Source, CRLF, [], 1, -1, -1, saSingleAllocation);
    W := Destination.Writer;
    A := False;
    P := 0;
    For I := 0 to Length (R) - 1 do
      begin
        S := R [I];
        Inc (P, Length (S) + 2);
        if (S <> '') and (S [1] = '.') then
          S := '.' + S;
        W.WriteLine (S, nlCRLF);
        if Assigned (ProgressCallback) then
          begin
            ProgressCallback (nil, Destination, P, A);
            if A then
              raise EStreamOperationAborted.Create;
          end;
      end;
    W.WriteLine ('.', nlCRLF);
  End;



{                                                                              }
{ AStream                                                                      }
{                                                                              }
Function AStream.EOF : Boolean;
  Begin
    Result := Position >= Size;
  End;

Procedure AStream.ReadBuffer (var Buffer; const Size : Integer);
  Begin
    if Size <= 0 then
      exit;
    if Read (Buffer, Size) <> Size then
      raise EStream.Create ('Read error');
  End;

Function AStream.ReadByte : Byte;
  Begin
    ReadBuffer (Result, 1);
  End;

Procedure AStream.WriteBuffer (const Buffer; const Size : Integer);
  Begin
    if Size <= 0 then
      exit;
    if Write (Buffer, Size) <> Size then
      raise EStream.Create ('Write error');
  End;

Procedure AStream.WriteStr (const S : String);
  Begin
    WriteBuffer (Pointer (S)^, Length (S));
  End;

Procedure AStreamCopyCallback (const Source, Destination : AStream; const BytesCopied : Int64; var Abort : Boolean);
  Begin
    Assert (Assigned (Source) and Assigned (Destination) and not Abort, 'Assigned (Source) and Assigned (Destination) and not Abort');
    Source.TriggerCopyProgressEvent (Source, Destination, BytesCopied, Abort);
    if Abort then
      exit;
    Destination.TriggerCopyProgressEvent (Source, Destination, BytesCopied, Abort);
  End;

Procedure AStream.TriggerCopyProgressEvent (const Source, Destination : AStream; const BytesCopied : Int64; var Abort : Boolean);
  Begin
    if Assigned (FOnCopyProgress) then
      FOnCopyProgress (Source, Destination, BytesCopied, Abort);
  End;

Procedure AStream.Assign (const Source : TObject);
  Begin
    if not Assigned (Source) then
      raise EStream.Create ('Invalid source');
    if Source is AStream then
      Size := CopyStream (AStream (Source), self, 0, 0, 0, -1, AStreamCopyCallback, False) else
      raise EStream.Create ('Assign not defined for source type');
  End;

Function AStream.WriteTo (const Destination : AStream; const BlockSize : Integer; const Count : Int64) : Int64;
  Begin
    Result := CopyStream (self, Destination, Position, Destination.Position,
        BlockSize, Count, AStreamCopyCallback, False);
  End;



{                                                                              }
{ TReaderWriter                                                                }
{                                                                              }
Constructor TReaderWriter.Create (const Reader : AReaderEx; const Writer : AWriterEx; const ReaderOwner : Boolean; const WriterOwner : Boolean);
  Begin
    inherited Create;
    FReader := Reader;
    FReaderOwner := ReaderOwner;
    FWriter := Writer;
    FWriterOwner := WriterOwner;
  End;

Destructor TReaderWriter.Destroy;
  Begin
    if FReaderOwner then
      FReader.Free;
    FReader := nil;
    if FWriterOwner then
      FWriter.Free;
    FWriter := nil;
    inherited Destroy;
  End;

Procedure TReaderWriter.RaiseNoReaderError;
  Begin
    raise EReaderWriter.Create ('No reader');
  End;

Procedure TReaderWriter.RaiseNoWriterError;
  Begin
    raise EReaderWriter.Create ('No writer');
  End;

Function TReaderWriter.GetPosition : Int64;
  Begin
    if Assigned (FReader) then
      Result := FReader.Position else
    if Assigned (FWriter) then
      Result := FWriter.Position else
      Result := 0;
  End;

Procedure TReaderWriter.SetPosition (const Position : Int64);
  Begin
    if Assigned (FReader) then
      FReader.Position := Position;
    if Assigned (FWriter) then
      FWriter.Position := Position;
  End;

Function TReaderWriter.GetReader : AReaderEx;
  Begin
    Result := FReader;
  End;

Function TReaderWriter.GetWriter : AWriterEx;
  Begin
    Result := FWriter;
  End;

Function TReaderWriter.GetSize : Int64;
  Begin
    if Assigned (FWriter) then
      Result := FWriter.Size else
    if Assigned (FReader) then
      Result := FReader.Size else
      Result := 0;
  End;

Procedure TReaderWriter.SetSize (const Size : Int64);
  Begin
    if not Assigned (FWriter) then
      RaiseNoWriterError;
    FWriter.Size := Size;
  End;

Function TReaderWriter.Read (var Buffer; const Size : Integer) : Integer;
  Begin
    if not Assigned (FReader) then
      RaiseNoReaderError;
    Result := FReader.Read (Buffer, Size);
  End;

Function TReaderWriter.Write (const Buffer; const Size : Integer) : Integer;
  Begin
    if not Assigned (FWriter) then
      RaiseNoWriterError;
    Result := FWriter.Write (Buffer, Size);
  End;



{                                                                              }
{ TFileStream                                                                  }
{                                                                              }
Constructor TFileStream.Create (const FileName : String; const OpenMode : TFileStreamOpenMode);
const WriterModes : Array [TFileStreamOpenMode] of TFileWriterOpenMode =
      (fwomOpen, fwomOpen, fwomCreate, fwomCreateIfNotExist);
var W : TFileWriter;
    R : AReaderEx;
  Begin
    FFileName := FileName;
    if OpenMode = fsomRead then
      begin
        W := nil;
        R := TFileReader.Create (FileName);
      end else
      begin
        W := TFileWriter.Create (FileName, WriterModes [OpenMode]);
        try
          R := TFileReader.Create (W.Handle, False);
        except
          W.Free;
          raise;
        end;
      end;
    inherited Create (R, W, True, True);
  End;

Constructor TFileStream.Create (const FileHandle : Integer; const HandleOwner : Boolean);
var W : TFileWriter;
    R : TFileReader;
  Begin
    W := TFileWriter.Create (FileHandle, HandleOwner);
    try
      R := TFileReader.Create (FileHandle, False);
    except
      W.Free;
      raise;
    end;
    inherited Create (R, W, True, True);
  End;

Function TFileStream.GetFileHandle : Integer;
  Begin
    Assert (Assigned (FReader), 'Assigned (FReader)');
    Result := TFileReader (FReader).Handle;
  End;

Function TFileStream.GetFileCreated : Boolean;
  Begin
    Result := Assigned (FWriter) and TFileWriter (FWriter).FileCreated;
  End;

Procedure TFileStream.SetPosition (const Position : Int64);
  Begin
    if Assigned (FWriter) then
      FWriter.Position := Position else
    if Assigned (FReader) then
      FReader.Position := Position;
  End;

Procedure TFileStream.DeleteFile;
  Begin
    if FFileName = '' then
      raise EFileStream.Create ('No filename');
    SysUtils.DeleteFile (FFileName);
  End;



{                                                                              }
{ Self-testing code                                                            }
{                                                                              }
Procedure SelfTest;
  Begin
  End;



end.