[Lazarus] Can't copy TMemoryStream to TProcess.Input

[Leonardo M. Ramé]

Hi, it must be that I've been working for more than 8 hrs but I can't find where the problem is...

I need to pass a file via stdIn to TProcess, then capture the StdOut. This
program should do what I expect, but, instead it hangs after writing aprox
293000 bytes to Proc.Input stream.

Can you take a look at it?. 

program test;

{$mode objfpc}{$H+}

uses
  SysUtils, Classes, 
  process,
  math;


function CompressLZMA(AStream: TMemoryStream): TMemoryStream;
var
  Proc: TProcess;
  lBuffer: array [0..2048] of byte;
  ReadCount: integer;
  lPos: LongInt;
begin
  Result := TMemoryStream.Create;
  AStream.Position:= 0;
  writeln('-1-');
  Proc := TProcess.Create(nil); //Create a new process
  try
    Proc.Executable := '/usr/bin/lzma'; //Run lzma
    Proc.Parameters.Add('--compress');
    Proc.Options := [poUsePipes, poStderrToOutPut];
    Proc.Execute; 

    writeln(format('Writing %d bytes...', [AStream.Size]));

    lPos := 0;
    while(lPos < AStream.Size) do
    begin
      writeln(format('Pos: %d - Size: %d', [lPos, AStream.Size]));
      ReadCount := AStream.Read(lBuffer, SizeOf(lBuffer));
      Proc.Input.Write(lBuffer, ReadCount);
      lPos := lPos + ReadCount;
    end;

  writeln('-2-');
    Proc.CloseInput;

  writeln('-3-');
    while Proc.Running or (Proc.Output.NumBytesAvailable > 0) do
    begin

  writeln('-4-');
      while Proc.Output.NumBytesAvailable > 0 do
      begin
        ReadCount := Min(512, Proc.Output.NumBytesAvailable); 
        Proc.Output.Read(lBuffer, ReadCount);
        Result.Write(lBuffer, ReadCount);
        writeln(format('%d', [ReadCount]));
      end;
    end;
    Result.Position:= 0;
  finally
    Proc.Free;
  end;
end; 

var
  lStr: TMemoryStream;
begin
  lStr := TMemoryStream.Create;
  try
    lStr.LoadFromFile('binary.file');
    CompressLZMA(lStr).SaveToFile('output.lzma');    
  finally
    lStr.Free;
  end;
end.

-- 
Leonardo M. Ramé
http://leonardorame.blogspot.com