TFileStream unter Delphi 10?

[FAlter]

Hallo zusammen,

ich habe mal nach längerer Zeit wieder eine Frage. Ich wollte mal das neue Delphi ausprobieren, da es nervt, Dateinamen ohne asiatische Sonderzeichen nicht öffnen zu können, und habe gerade Delphi 10 Starter heruntergeladen. Leider habe ich im Delphi-Verzeichnis keinen Source zur RTL gefunden. Aber eine Klasse TBufferedFS, die von TFileStream abgeleitet war, hat nicht mehr richtig funktioniert, da ich in einem Coding ein TStream.CopyFrom hatte und das hat von dem TBufferesFS falsche Daten kopiert. Dabei habe ich festgestellt, dass TBufferedFS gar nicht aufgerufen wurde.

Ich habe das nun so gelöst, dass ich TBufferedFS direkt von TStream ableite und dort ein Feld mit einem TFileStream Objekt angelegt habe und alle inherited Read/Write/Seek-Aufrufe habe ich auf dieses umgebogen. Nun funktioniert das CopyFrom wieder.

Meine Frage ist nun, was an T(File)Stream hier anders ist, sodass dieses Coding mit dem Wechsel auf Delphi 10 nicht mehr funktioniert hat. 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. Weiß jemand welches, damit ich zukünftig aufpassen kann wenn ich alte Programme migriere? Wo kann ich Infos zu solchen internen Unterschieden finden oder wo liegen die Sorces (vermutlich liegen die bei der Starter nicht bei?)

Viele Grüße

Felix

[Uwe Raabe]

Es wäre jetzt vielleicht hilfreich, den Sourcen von TBufferedFS zu zeigen.

[jaenicke]

Zitat von FAlter:

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;

Dass TStream.ReadBuffer und TStream.WriteBuffer aufgerufen werden, kannst du auch ohne Quelltext sehen:

Zitat von FAlter:

wo liegen die Sorces (vermutlich liegen die bei der Starter nicht bei?)

Richtig!

Dass es mehrere überladene Varianten gibt, kannst du auch ohne Quelltext in der Syntaxergänzung sehen:

Dass dann eine andere benutzt wird, musst du dann schlussfolgern.

[FAlter]

Zitat von jaenicke:

Zitat von FAlter:

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

[Uwe Raabe]

Es gibt in Delphi mittlerweile auch ein TBufferedFileStream . Das überschreibt die beiden virtuellen Read -Methoden. Das ist auch nötig, da die Implementierung von THandleStream (dem Vorfahr von TFileStream ) diese beiden Methoden separat implementiert. Mit der Implementierung beider Varianten ist man somit immer auf der sicheren Seite.

Delphi-Quellcode:

    function Read(var Buffer; Count: Longint): Longint; override;
    function Read(Buffer: TBytes; Offset, Count: Longint): Longint; override;

In der Implementierung ruft die zweite die erste auf.

[FAlter]

Hi,

danke, dann passt die Anpassung erstmal, wenn die "neue" die "alte" ruft - und den TBufferedFileStream kann ich ja auch mal anschauen, vielleicht erübrigt sich das ja dann damit. Im Moment wollte ich erst mal ein altes Projekt ans Laufen bringen, und das ich habe zumindest nun keinen weiteren Fehler mehr festgestellt.

Viele Grüße

Felix