Einzelnen Beitrag anzeigen

Benutzerbild von FAlter
FAlter

Registriert seit: 21. Jul 2004
Ort: Ostfildern
1.096 Beiträge
 
FreePascal / Lazarus
 
#4

AW: TFileStream unter Delphi 10?

  Alt 23. Jul 2017, 14:48
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
Felix Alter

Geändert von FAlter (23. Jul 2017 um 14:56 Uhr)
  Mit Zitat antworten Zitat