fix messages from processes sometime cut

This commit is contained in:
Basile Burg 2014-11-15 18:37:28 +01:00
parent 61def85939
commit d0d230cc2d
1 changed files with 16 additions and 6 deletions

View File

@ -698,8 +698,7 @@ var
str: TMemoryStream; str: TMemoryStream;
sum: Integer; sum: Integer;
cnt: Integer; cnt: Integer;
const buffSz: Integer;
buffSz = 1024;
begin begin
if not (poUsePipes in aProcess.Options) then if not (poUsePipes in aProcess.Options) then
exit; exit;
@ -707,11 +706,22 @@ begin
sum := 0; sum := 0;
str := TMemoryStream.Create; str := TMemoryStream.Create;
try try
buffSz := aProcess.PipeBufferSize;
// temp fix: messages are cut if the TAsyncProcess version is used on simple TProcess.
if aProcess is TAsyncProcess then begin
while aProcess.Output.NumBytesAvailable <> 0 do begin while aProcess.Output.NumBytesAvailable <> 0 do begin
str.Size := str.Size + buffSz; str.Size := sum + buffSz;
cnt := aProcess.Output.Read((str.Memory + sum)^, buffSz); cnt := aProcess.Output.Read((str.Memory + sum)^, buffSz);
sum += cnt; sum += cnt;
end; end;
end else begin
repeat
str.Size := sum + buffSz;
cnt := aProcess.Output.Read((str.Memory + sum)^, buffSz);
sum += cnt;
until
cnt = 0;
end;
str.Size := sum; str.Size := sum;
aList.LoadFromStream(str); aList.LoadFromStream(str);
finally finally