Delphi-PRAXiS - TFileStream unter Delphi 10?

Zitat:

Zitat von jaenicke (Beitrag 1377282)

Zitat:

Zitat von FAlter (Beitrag 1377280)

Laut Doku zu Delphi 10 ruft TStream.CopyFrom intern TStream.ReadBuffer, und TStream.ReadBuffer ruft TStream.Read - und genau das ist nicht passiert, das heißt eines der beiden muss in TFileStream ohne den entsprechenden Aufruf überschrieben sein.

Es gibt mehrere Varianten von ReadBuffer. Ich vermute du hast eine andere überschrieben. Benutzt wird die typsichere Variante:

Delphi-Quellcode:

			    procedure ReadBuffer(var Buffer: TBytes; Count: NativeInt); overload;

    procedure WriteBuffer(const Buffer: TBytes; Count: NativeInt); overload;

Die ist vermutlich neu. Überschrieben ist allerdings nur die (alte, nicht typsichere) Read. Aber es ist wohl genau da das Problem, da es auch eine zweite neue Read gibt.

Insofern jetzt meine Frage (die ich über die Hilfe nicht klären konnte), reicht es eine der Read zu überschreiben (die "alte"), damit ich ein Coding haben kann das von Turbo Delphi, Lazarus und dem neuen Delphi compiliert werden kann? Ich nehme mal an, in TStream rufen sich die überladenen Methoden Read bzw. Write gegenseitig auf, sodass nur eine in abgeleiteten Klassen überschrieben werden muss. Dann wäre meine Anpassung ja nun ok.

Die Unit lag meine ich ursprünglich beim LZMA SDK bei, welches ohne die zusätzliche Pufferung extrem langsam würde. Ich habe sie damals angepasst, indem ich das Pufferarray durch ein dynamisches Array ersetzt habe. Nachdem das Original laut

http://www.7-zip.de/sdk.html unter Public Domain steht kann ich die Klasse gerne hier posten - mein Anteil daran dürfte minimal sein.

Hier die (nun von mir für Delphi 10 angepasste) Klasse im Source (ich bin gerade dabei, einen neuen Konstruktor zu machen - den habe ich mal auskommentiert da nicht fertig):

Delphi-Quellcode:

			unit UBufferedFS;

{$IFDEF FPC}

{$MODE Delphi}

{$ENDIF}

interface

uses SysUtils, Classes, Math;

type

  TBFSMode = (BFMRead, BFMWrite);

  TBufferedFS = class(TStream)

  private

    membuffer: array of Byte;

    BufferSize: Integer;

    bytesinbuffer: Integer;

    bufferpos: Integer;

    bufferdirty: Boolean;

    Mode: TBFSMode;

    FStream: TStream;

    FOwnStream: Boolean;

    procedure Init;

    procedure Flush;

    procedure FillBuffer;

  public

    constructor Create(const FileName: String; Mode: Word;

      BufSize: Integer = $10000); overload;

    constructor Create(AHandle: THandle; BufSize: Integer = $10000);

      overload;

//    constructor Create(AStream: TStream; Owned: Boolean = false;

//      BufSize: Integer = $10000); overload;

    destructor Destroy; override;

    function Read(var Buffer; Count: Longint): Longint; override;

    function Write(const Buffer; Count: Longint): Longint; override;

    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;

      override;

  end;

implementation

function MovePointer(const P: pointer; const dist: Integer): pointer;

  inline;

begin

  result := pointer(Integer(p) + dist);

end;

procedure TBufferedFS.Init;

begin

  bytesinbuffer := 0;

  bufferpos     := 0;

  bufferdirty   := FALSE;

  mode          := BFMWrite;

end;

procedure TBufferedFS.Flush;

begin

  if bufferdirty then

    inherited Write(membuffer[0], bufferpos);

  bufferdirty   := FALSE;

  bytesinbuffer := 0;

  bufferpos     := 0;

end;

constructor TBufferedFS.Create(const FileName: String; Mode: Word;

  BufSize: Integer);

begin

  inherited Create;

  FStream := TFileStream.Create(FileName, Mode);

  FOwnStream := true;

  SetLength(membuffer, BufSize);

  BufferSize := BufSize;

  init;

end;

constructor TBufferedFS.Create(AHandle: THandle; BufSize: Integer);

begin

  inherited Create;

  FStream := TFileStream.Create(AHandle);

  FOwnStream := true;

  SetLength(membuffer, BufSize);

  BufferSize := BufSize;

  init;

end;

//constructor TBufferedFS.Create(AStream: TStream; Owned: Boolean = false;

//  BufSize: Integer = $10000);

//begin

//  inherited Create;

//  FStream := AStream;

//  FOwnStream := Owned;

//  SetLength(membuffer, BufSize);

//  BufferSize := BufSize;

//  init;

//end;

destructor TBufferedFS.Destroy;

begin

  flush;

  inherited;

end;

procedure TBufferedFS.FillBuffer;

begin

  flush;

  bytesinbuffer := FStream.Read(membuffer[0], buffersize);

end;

function TBufferedFS.Read(var Buffer; Count: Longint): Longint;

var

  p:           PByte;

  bytestoread: Integer;

  b:           Integer;

begin

  Assert(Count >= 0, 'Count must not be a negative number!');

  if Mode = BFMWrite then

  begin

    flush;

    mode   := BFMRead;

  end;

  result := 0;

  if Count = 0 then

    exit;

  if count <= bytesinbuffer then

  begin

    //all data already in buffer

    move(membuffer[bufferpos], buffer, count);

    dec(bytesinbuffer, count);

    inc(bufferpos, count);

    result := count;

  end

  else

  begin

    bytestoread := count;

    p := @buffer;

    if (bytesinbuffer <> 0) then

    begin

      //read data remaining in buffer and increment data pointer

      b := Read(p^, bytesinbuffer);

      inc(p, b);

      dec(bytestoread, b);

      result := b;

    end;

    if bytestoread >= BufferSize then

    begin

      //data to read is larger than the buffer, read it directly

      result := result + FStream.Read(p^, bytestoread);

    end

    else

    begin

      //refill buffer

      FillBuffer;

      //recurse

      result := result + Read(p^, math.Min(bytestoread, bytesinbuffer));

    end;

  end;

end;

function TBufferedFS.Write(const Buffer; Count: Longint): Longint;

var

  p: pointer;

  bytestowrite: Integer;

  b: Integer;

  Pos: Int64;

begin

  if mode = BFMRead then

  begin

    Pos := Seek(0, soCurrent);

    FStream.seek(Pos, soFromBeginning);

    bytesinbuffer := 0;

    bufferpos     := 0;

  end;

  mode   := BFMWrite;

  result := 0;

  if count <= BufferSize - bytesinbuffer then

  begin

    //all data fits in buffer

    bufferdirty := TRUE;

    move(buffer, membuffer[bufferpos], count);

    inc(bytesinbuffer, count);

    inc(bufferpos, count);

    result        := count;

  end else

  begin

    bytestowrite := count;

    if (bytestowrite <> 0) And (bytesinbuffer <> BufferSize) And

      (bytesinbuffer <> 0) then

    begin

      //write data to remaining space in buffer and increment data pointer

      b      := Write(buffer, BufferSize - bytesinbuffer);

      p      := MovePointer( @buffer, b);

      dec(bytestowrite, b);

      result := b;

    end else

      p := @buffer;

    if bytestowrite >= BufferSize then

    begin

      //empty buffer

      Flush;

      //data to write is larger than the buffer, write it directly

      result := result + FStream.Write(p^, bytestowrite);

    end else

    begin

      //empty buffer

      Flush;

      //recurse

      result := result + Write(p^, bytestowrite);

    end;

  end;

end;

function TBufferedFS.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;

var

  X: Int64;

begin

  if (Origin = soCurrent) And (Offset = 0) then

  begin

    if Mode = BFMWrite then

      result := FStream.seek(Offset, origin) + bufferpos

    else

      result := FStream.seek(Offset, origin) - BytesInBuffer;

   if Result < 0 then

     Result := 0;

  end

  else

  begin

    case Origin of

      soCurrent:

      begin

        X := bufferpos + Offset;

        if (X < 0) or (X >= BytesInBuffer) or (Mode = BFMWrite) then

        begin

          X := Seek(0, soCurrent);

          flush;

          result := FStream.seek(X + Offset, soBeginning);

        end

        else

        begin

          BufferPos := X;

          dec(BytesInBuffer, Offset);

          Result := Seek(0, soCurrent);

        end;

      end;

      soBeginning:

      begin

        Assert(Offset >= 0);

        Result := seek(Offset - Seek(0, soCurrent), soCurrent);

      end;

      soEnd:

      begin

        flush;

        result := FStream.Seek(offset, origin);

      end;

      else

        raise EStreamError.Create(

          'Seek: not (origin in [soCurrent, soBeginning, soEnd])');

    end;

  end;

end;

end.

[edit]Falls jemand das findet uns in eigenen Programmen ergänzen möchte, ich habe das FStream.Free noch nicht im Destruktor ergänzt. Die Idee war, die Freigabe von FOwnStream abhängig zu machen - um beim Erzeugen mittels bereits bestehendem Stream dem Erzeuger die Möglichkeit der Kontrolle zu überlassen.[/edit]

Viele Grüße

Felix