lvkstreamfilters.pas

单独打包出来

        programmed to do, and optionally/eventually contacts the next filter
        in the sequence to write or read data. B in turn contacts A, and A
        in turn operates on the core stream. This way, data is passed down
        through the filters and back again.
      Parameters:
        CoreStream - The core TStream class to operate on. Data will
          eventually be written to this stream or read from it, depending
          on what kind of filters are used.
        OwnsCoreStream - If this parameters is set to True, then CoreStream
          will be automatically destroyed when this stream class is destroyed.
        Filters - Array of filters to use. The last filter in the list is
          the topmost filter. The first filter in the list is the filter
          closest to the core stream.
    }
    constructor Create(const CoreStream: TStream; const OwnsCoreStream: Boolean;
      const Filters: array of IStreamFilter);

    { Description:
        This destructor will clean up and flush any and all output buffers
        and remove the filter sequence from memory. If the filters are not
        referenced elsewhere, they will be cleaned up in the process.
    }
    destructor Destroy; override;

    { Description:
        This implements the Read method as inherited from TStream.
    }
    function Read(var Buffer; Count: Longint): Longint; override;

    { Description:
        This implements the Write method as inherited from TStream.
    }
    function Write(const Buffer; Count: Longint): Longint; override;
  {$IFDEF VER140}

    { Description:
        This implements the Seek method as inherited from TStream.
    }
    function Seek(Offset: Longint; Origin: Word): Longint; overload; override;

    { Description:
        This implements the Seek method as inherited from TStream.
    }
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
      overload; override;
  {$ELSE}

    { Description:
        This implements the Seek method as inherited from TStream.
    }
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  {$ENDIF}

    { Description:
        This method executes a manual flush of data pending in output
        buffers. Please note that unless you're at the very end of the data,
        many filters will not react well to being flushed mid-stream so to
        speak.
    }
    procedure FlushOutput; virtual;
  end;

  { Description:
      This exception class is the base class for all exceptions raised within
      the classes related to the stream filter code.
  }
  EStreamFilter = class(Exception);

  { Description:
      This exception class will be raised from within Read methods when
      there is a problem reading from the filter.
  }
  EStreamRead = class(EStreamFilter);

  { Description:
      This exception class will be raised from within Write methods when
      there is a problem writing to the filter.
  }
  EStreamWrite = class(EStreamFilter);

  { Description:
      This exception class will be raised from within Seek methods when
      there is a problem seeking on the filter.
  }
  EStreamSeek = class(EStreamFilter);

  { Description:
      This exception class will be raised from within Seek methods when
      there is a problem sizing the filter.
  }
  EStreamSize = class(EStreamFilter);

implementation

type
  TInternalCoreFilter = class(TInterfacedObject,
    IStreamFilter, IReadableStreamFilter, IWriteableStreamFilter,
    ISeekableStreamFilter, ISizeableStreamFilter)
  private
    FCoreStream : TStream;

  protected
    // IStreamFilter interface
    procedure SetNextFilter(const Filter: IStreamFilter);
    function GetPackageVersion: TPackageVersion;

    // IReadableStreamFilter interface
    function Read(var Buffer; const Count: Longint): Longint;

    // IWriteableStreamFilter interface
    function Write(const Buffer; const Count: Longint): Longint;
    procedure Flush;

    // ISeekableStreamFilter interface
    function Seek(const Offset: Int64; const Origin: TSeekOrigin): Int64;

    // ISizeableStreamFilter interface
    procedure SetSize(const NewSize: Int64);

  public
    constructor Create(const CoreStream: TStream);
  end;

{ TlvkFilteredStream }

constructor TlvkFilteredStream.Create(const CoreStream: TStream;
  const OwnsCoreStream: Boolean; const Filters: array of IStreamFilter);
var
  Index : Integer;
begin
  Assert(Assigned(CoreStream), 'No stream');
  Assert(Length(Filters)>0, 'No filters');

  inherited Create;

  FCoreStream := CoreStream;
  FOwnsCoreStream := OwnsCoreStream;
  SetLength(FFilters, Length(Filters)+1);
  FFilters[Low(FFilters)] := TInternalCoreFilter.Create(FCoreStream) as
    IStreamFilter;
  for Index := Low(FFilters)+1 to High(FFilters) do
    FFilters[Index] := Filters[Index-(Low(FFilters)+1)+Low(Filters)];

  for Index := Low(FFilters)+1 to High(FFilters) do
    FFilters[Index].SetNextFilter(FFilters[Index-1]);

  FTopFilter := FFilters[High(FFilters)];
end;

destructor TlvkFilteredStream.Destroy;
var
  Index : Integer;
begin
  FlushOutput;

  if Length(FFilters) > 0 then
  begin
    FTopFilter := nil;
    for Index := High(FFilters) downto Low(FFilters) do
      FFilters[Index].SetNextFilter(nil);
  end;
  SetLength(FFilters, 0);

  if FOwnsCoreStream then
    FCoreStream.Free;

  inherited;
end;

procedure TlvkFilteredStream.FlushOutput;
var
  Index : Integer;
  wsf   : IWriteableStreamFilter;
begin
  for Index := High(FFilters) downto Low(FFilters) do
    if FFilters[Index].QueryInterface(IWriteableStreamFilter, wsf) = S_OK then
      wsf.Flush;
end;

function TlvkFilteredStream.Read(var Buffer; Count: Integer): Longint;
var
  rsf : IReadableStreamFilter;
begin
  Assert(Assigned(TopFilter), 'No filters');

  if TopFilter.QueryInterface(IReadableStreamFilter, rsf) = S_OK then
    Result := rsf.Read(Buffer, Count)
  else
    raise EStreamRead.Create('Top filter is not readable in call to Read');
end;

function TlvkFilteredStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  Result := Seek(Int64(Offset), Origin);
end;

{$IFDEF VER140}
function TlvkFilteredStream.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
var
  ssf : ISeekableStreamFilter;
begin
  Assert(Assigned(TopFilter), 'No filters');

  if TopFilter.QueryInterface(ISeekableStreamFilter, ssf) = S_OK then
    Result := ssf.Seek(Offset, Origin)
  else
    raise EStreamSeek.Create('Top filter is not seekable in call to Seek');
end;
{$ENDIF}

{$IFDEF VER140}
procedure TlvkFilteredStream.SetSize(NewSize: Integer);
begin
  SetSize(Int64(NewSize));
end;

procedure TlvkFilteredStream.SetSize(const NewSize: Int64);
var
  ssf : ISizeableStreamFilter;
begin
  Assert(Assigned(TopFilter), 'No filters');

  if TopFilter.QueryInterface(ISizeableStreamFilter, ssf) = S_OK then
    ssf.SetSize(NewSize)
  else
    raise EStreamSize.Create('Top filter is not sizeable in call to SetSize');
end;
{$ELSE}
procedure TlvkFilteredStream.SetSize(NewSize: Integer);
var
  ssf : ISizeableStreamFilter;
begin
  Assert(Assigned(TopFilter), 'No filters');

  if TopFilter.QueryInterface(ISizeableStreamFilter, ssf) = S_OK then
    ssf.SetSize(NewSize)
  else
    raise EStreamSize.Create('Top filter is not sizeable in call to SetSize');
end;
{$ENDIF}

function TlvkFilteredStream.Write(const Buffer; Count: Integer): Longint;
var
  wsf : IWriteableStreamFilter;
begin
  Assert(Assigned(TopFilter), 'No filters');

  if TopFilter.QueryInterface(IWriteableStreamFilter, wsf) = S_OK then
    Result := wsf.Write(Buffer, Count)
  else
    raise EStreamWrite.Create('Top filter is not writeable in call to Write');
end;

{ TInternalCoreFilter }

constructor TInternalCoreFilter.Create(const CoreStream: TStream);
begin
  inherited Create;

  FCoreStream := CoreStream;
end;

procedure TInternalCoreFilter.Flush;
begin
  // Do nothing here
end;

function TInternalCoreFilter.GetPackageVersion: TPackageVersion;
begin
  Result := lvkVersion.PackageVersion;
end;

function TInternalCoreFilter.Read(var Buffer;
  const Count: Integer): Longint;
begin
  Result := FCoreStream.Read(Buffer, Count);
end;

function TInternalCoreFilter.Seek(const Offset: Int64;
  const Origin: TSeekOrigin): Int64;
const
  Origins : array[TSeekOrigin] of Word = (
    Classes.soFromBeginning,
    Classes.soFromCurrent,
    Classes.soFromEnd
  );
begin
  {$IFDEF VER140}
  Result := FCoreStream.Seek(Offset, Origin);
  {$ELSE}
  Result := FCoreStream.Seek(Offset, Origins[Origin]);
  {$ENDIF}
end;

procedure TInternalCoreFilter.SetNextFilter(const Filter: IStreamFilter);
begin
  // Do nothing here
end;

procedure TInternalCoreFilter.SetSize(const NewSize: Int64);
begin
  FCoreStream.Size := NewSize;
end;

function TInternalCoreFilter.Write(const Buffer;
  const Count: Integer): Longint;
begin
  Result := FCoreStream.Write(Buffer, Count);
end;

end.