System.Zip.LZMA can't be used by any code, that expects TStream descendant

[Torbins]

TLZMAEncoderStream and TLZMADecoderStream implement TStream interface incorrectly, that is why it is impossible to use them with stock System.Zip, or any other code, that expects TStream descendant. Please, implement support for reading and writing in chunks from any buffer, as expected by TStream.

[Torbins]

Here is my attempt to fix this:

unit System.Zip.LZMA;

interface

uses
  System.SysUtils, System.Classes, System.SyncObjs, System.Zip, LzmaDec, LzmaEnc, LzmaTypes;

type
  ELZMAException = class(Exception);

  PZipHeader = ^TZipHeader;

  PLzmaEncoderRead = ^TLzmaEncoderRead;
  TLzmaEncoderRead = record
    Proc: TInStreamReadProc;
    Buffer: Pointer;
    BufferSize: Longint;
    BufferPos: Longint;
    BufferFull: TLightweightEvent;
    BufferEmpty: TLightweightEvent;
    WaitingBytes: UInt64;
  end;

  TLZMAEncoderStream = class(TStream)
  private
    FStream: TStream;
    FEncoderThread: TThread;
    FEncReadData: TLzmaEncoderRead;
    FBufferFullEvent: TLightweightEvent;
    FBufferEmptyEvent: TLightweightEvent;
    FProgress: TZipProgressEvent;
    FZipHeader: PZipHeader;
  protected
    procedure HandleThreadException;
  public
    constructor Create(const Stream: TStream; aZipHeader: PZipHeader; const
        aProgress: TZipProgressEvent); reintroduce;
    destructor Destroy; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

  TLZMADecoderStream = class(TStream)
  private
    FCurrentDataLen: UInt32;
    FData: TBytes;
    FDataLen: UInt32;
    FLzmaState: TCLzmaDec;
    FStream: TStream;
    FProgress: TZipProgressEvent;
    FZipHeader: TZipHeader;
    FDecompressSize: Int64;
  public
    constructor Create(const Stream: TStream; aZipHeader: TZipHeader; const
        aProgress: TZipProgressEvent); reintroduce;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    function Read(Buffer: TBytes; Offset, Count: Longint): Longint; override;
  end;

implementation

uses
  System.Math, Winapi.Windows;

type
  PzmaEncoderWrite = ^TLzmaEncoderWrite;
  TLzmaEncoderWrite = record
    Proc: TOutStreamWriteProc;
    Stream: TStream;
  end;

  PLzmaCompressProgress = ^TLzmaCompressProgress;
  TLzmaCompressProgress = record
    Proc: TCompressProgressProc;
    ZipHeader: TZipHeader;
    Progress: TZipProgressEvent;
  end;

function LzmaReadProc(p: PISeqInStream; buf: PByte; var size: SIZE_T): TSRes; cdecl;
var R: PLzmaEncoderRead;
begin
  try
    R := PLzmaEncoderRead(p);

    if R.WaitingBytes = 0 then
    begin
      size := 0;
      Exit(SZ_OK);
    end;

    R.BufferFull.WaitFor;

    size := Min(size, R.BufferSize - R.BufferPos);
    Dec(R.WaitingBytes, size);
    CopyMemory(buf, R.Buffer, size);
    Inc(R.BufferPos, size);

    if R.BufferSize - R.BufferPos = 0 then
    begin
      R.BufferFull.ResetEvent;
      R.BufferEmpty.SetEvent;
    end;

    Result := SZ_OK;
  except
    Result := SZ_ERROR_DATA;
  end;
end;

function LzmaWriteProc(p: PISeqOutStream; const buf: Pointer; size: SIZE_T): SIZE_T; cdecl;
var R: PzmaEncoderWrite;
begin
  R := PzmaEncoderWrite(p);
  Result := R.Stream.Write(buf^, size);
end;

function LzmaProgressProc(p: PICompressProgress; inSize: UInt64; outSize: UInt64): TSRes; cdecl;
var R: PLzmaCompressProgress;
begin
  R := PLzmaCompressProgress(p);
  if Assigned(R.Progress) then
    R.Progress(nil, TEncoding.Default.GetString(R.ZipHeader.FileName), R.ZipHeader, inSize);
  Result := SZ_OK;
end;

constructor TLZMAEncoderStream.Create(const Stream: TStream; aZipHeader:
    PZipHeader; const aProgress: TZipProgressEvent);
begin
  inherited Create;

  FStream := Stream;
  FZipHeader := aZipHeader;
  FProgress := aProgress;

  FBufferFullEvent := TLightweightEvent.Create;
  FBufferEmptyEvent := TLightweightEvent.Create;
end;

destructor TLZMAEncoderStream.Destroy;
begin
  FEncoderThread.Free;
  FBufferFullEvent.Free;
  FBufferEmptyEvent.Free;

  inherited;
end;

procedure TLZMAEncoderStream.HandleThreadException;
begin
  if Assigned(FEncoderThread) and Assigned(FEncoderThread.FatalException) then
    raise ELZMAException.Create((FEncoderThread.FatalException as Exception).Message);
end;

function TLZMAEncoderStream.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
begin
  HandleThreadException;

  Result := 0;
  if (Offset = 0) and (Origin = soCurrent) then
    Result := FZipHeader.UncompressedSize64;
end;

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

  procedure RunEncoder;
  begin
    FEncReadData.Proc := LzmaReadProc;
    FEncReadData.BufferFull := FBufferFullEvent;
    FEncReadData.BufferEmpty := FBufferEmptyEvent;
    FEncReadData.WaitingBytes := FZipHeader.UncompressedSize64;

    FEncoderThread := TThread.CreateAnonymousThread(procedure
    var
      EncoderHandle: TCLzmaEncHandle;
      Allocator: TISzAlloc;

      procedure Construct;
      var
        Props: TCLzmaEncProps;
        PropData: TBytes;
        Version, WPropDataLen: Word;
        PropDataLen: SIZE_T;
      begin
        Version := 9 + 20 shl 8;
        FStream.Write(Version, SizeOf(Version));

        EncoderHandle := LzmaEnc_Create(Allocator);

        LzmaEncProps_Init(Props);
        Props.reduceSize := FZipHeader.UncompressedSize64;

        CheckLzma(LzmaEnc_SetProps(EncoderHandle, Props));

        PropDataLen := LZMA_PROPS_SIZE;
        SetLength(PropData, PropDataLen);
        CheckLzma(LzmaEnc_WriteProperties(EncoderHandle, PropData, PropDataLen));
        Assert(PropDataLen = LZMA_PROPS_SIZE);

        WPropDataLen := PropDataLen;

        FStream.Write(WPropDataLen, SizeOf(WPropDataLen));
        FStream.Write(PropData, PropDataLen);
      end;

    var
      EncWrite: TLzmaEncoderWrite;
      EncProgress: TLzmaCompressProgress;
    begin
      Allocator.Init;

      Construct;
      try
        EncWrite.Proc := LzmaWriteProc;
        EncWrite.Stream := FStream;

        EncProgress.Proc := LzmaProgressProc;
        EncProgress.ZipHeader := FZipHeader^;
        EncProgress.Progress := FProgress;

        CheckLzma(LzmaEnc_Encode(EncoderHandle, @EncWrite, @FEncReadData, @EncProgress, Allocator, Allocator));
      finally
        LzmaEnc_Destroy(EncoderHandle, Allocator, Allocator);
      end;
    end);

    FEncoderThread.FreeOnTerminate := False;
    FEncoderThread.Start;

    FBufferEmptyEvent.SetEvent;
  end;

begin
  if not Assigned(FEncoderThread) then
    RunEncoder;

  HandleThreadException;

  FBufferEmptyEvent.WaitFor;
  FBufferEmptyEvent.ResetEvent;

  FEncReadData.Buffer := @Buffer;
  FEncReadData.BufferSize := Count;
  FEncReadData.BufferPos := 0;

  FBufferFullEvent.SetEvent;
  FBufferEmptyEvent.WaitFor;

  Result := FEncReadData.BufferPos;
end;

constructor TLZMADecoderStream.Create(const Stream: TStream; aZipHeader:
    TZipHeader; const aProgress: TZipProgressEvent);
begin
  inherited Create;
  FStream := Stream;
  FZipHeader := aZipHeader;
  FProgress := aProgress;
  FDecompressSize := 0;
end;

procedure TLZMADecoderStream.AfterConstruction;
var PropData: TBytes;
    PropDataLen: Word;
    R: TISzAlloc;
begin
  inherited;
  FStream.Seek(2, soFromCurrent);  // Skip 2 bytes. Lzma library version

  FStream.Read(PropDataLen, 2);    // Properties size
  Assert(PropDataLen = LZMA_PROPS_SIZE);

  SetLength(PropData, PropDataLen);
  FStream.Read(PropData, PropDataLen);

  FLzmaState.Construct;
  R.Init;

  CheckLzma(LzmaDec_Allocate(FLzmaState, PropData[0], PropDataLen, R));

  LzmaDec_Init(FLzmaState);

  FCurrentDataLen := 0;

  FDataLen := $F000;
  SetLength(FData, FDataLen);
end;

procedure TLZMADecoderStream.BeforeDestruction;
var R: TISzAlloc;
begin
  R.Init;
  LzmaDec_Free(FLzmaState, R);
  FillChar(FLzmaState, SizeOf(FLzmaState), 0);
  inherited;
end;

function TLZMADecoderStream.Read(Buffer: TBytes; Offset, Count: Longint):
    Longint;
var Status: ELzmaStatus;
    OutLen, InLen: SIZE_T;
    BufferPos: LongInt;
begin
  BufferPos := 0;
  repeat
    if FCurrentDataLen = 0 then begin
      FCurrentDataLen := FStream.Read(FData[0], FDataLen);
      FDataLen := FCurrentDataLen;
    end;

    OutLen := Count - BufferPos;
    InLen := FCurrentDataLen;

    CheckLzma(LzmaDec_DecodeToBuf(FLzmaState, Buffer[BufferPos], OutLen, FData[FDataLen - FCurrentDataLen], InLen, LZMA_FINISH_ANY, Status));

    Dec(FCurrentDataLen, InLen);

    Inc(BufferPos, OutLen);
    Inc(FDecompressSize, OutLen);
  until Status <> LZMA_STATUS_NEEDS_MORE_INPUT;

  if Assigned(FProgress) then
    FProgress(Self, TEncoding.Default.GetString(FZipHeader.FileName), FZipHeader, FDecompressSize);

  Result := BufferPos;
end;

procedure RegisterLZMA;
begin
  TZipFile.RegisterCompressionHandler(zcLZMA,
    function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream
    begin
      Result := TLZMAEncoderStream.Create(InStream, @Item, ZipFile.OnProgress);
    end,
    function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream
    begin
      Result := TLZMADecoderStream.Create(InStream, Item, ZipFile.OnProgress);
    end
  );
end;

procedure UnregisterLZMA;
begin
  TZipFile.RegisterCompressionHandler(zcLZMA, nil, nil);
end;

initialization
  RegisterLZMA;

finalization
  UnregisterLZMA;

end.

[Torbins]

By the way, your definition of TCLzmaEncProps is out of sync with C-code.