forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

processOutputToStrings uses processOutputToStream

This commit is contained in:
Basile Burg 2015-07-07 18:54:06 +02:00
parent b8b72af8f3
commit bf115d9594
1 changed files with 22 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
src/ce_common.pas
View File

@ -166,7 +166,7 @@ type
function listAsteriskPath(const aPath: string; aList: TStrings; someExts: TStrings = nil): boolean; function listAsteriskPath(const aPath: string; aList: TStrings; someExts: TStrings = nil): boolean;
(** (**
* Lets the shell open a file * Lets the shell open a file.
*) *)
function shellOpen(const aFilename: string): boolean; function shellOpen(const aFilename: string): boolean;
@ -176,19 +176,19 @@ type
function exeInSysPath(anExeName: string): boolean; function exeInSysPath(anExeName: string): boolean;
(** (**
* Returns the full to anExeName. Works if exeInSysPath(). * Returns the full path to anExeName. Works if exeInSysPath() returns true.
*) *)
function exeFullName(anExeName: string): string; function exeFullName(anExeName: string): string;
(** (**
* Clears then fills aList with aProcess output stream. * Clears then fills aList with aProcess output stream.
*) *)
procedure processOutputToStrings(aProcess: TProcess; var aList: TStringList); procedure processOutputToStrings(proc: TProcess; strings: TStrings);
(** (**
* Copy available process output to a stream. * Copies process output to stream. Existing stream content is not cleared.
*) *)
procedure processOutputToStream(aProcess: TProcess; output: TMemoryStream); procedure processOutputToStream(proc: TProcess; stream: TMemoryStream);
(** (**
* Terminates and frees aProcess. * Terminates and frees aProcess.
@ -710,61 +710,41 @@ begin
end; end;
end; end;
procedure processOutputToStrings(aProcess: TProcess; var aList: TStringList); procedure processOutputToStrings(proc: TProcess; strings: TStrings);
var var
str: TMemoryStream; str: TMemoryStream;
sum: Integer;
cnt: Integer;
buffSz: Integer;
begin begin
if not (poUsePipes in aProcess.Options) then if not (poUsePipes in proc.Options) then
exit; exit;
// //
// note: aList.LoadFromStream() does not work, lines can be split, which breaks message parsing (e.g filename detector).
//
sum := 0;
str := TMemoryStream.Create; str := TMemoryStream.Create;
try try
buffSz := aProcess.PipeBufferSize; processOutputToStream(proc, str);
// temp fix: messages are cut if the TAsyncProcess version is used on simple TProcess. str.Position := 0;
if aProcess is TAsyncProcess then begin strings.LoadFromStream(str);
while aProcess.Output.NumBytesAvailable <> 0 do begin
str.SetSize(sum + buffSz);
cnt := aProcess.Output.Read((str.Memory + sum)^, buffSz);
sum += cnt;
end;
end else begin
repeat
str.SetSize(sum + buffSz);
cnt := aProcess.Output.Read((str.Memory + sum)^, buffSz);
sum += cnt;
until
cnt = 0;
end;
str.Size := sum;
aList.LoadFromStream(str);
finally finally
str.Free; str.Free;
end; end;
end; end;
procedure processOutputToStream(aProcess: TProcess; output: TMemoryStream); procedure processOutputToStream(proc: TProcess; stream: TMemoryStream);
var var
sum, cnt: Integer; sum, cnt: Integer;
const buffSz: Integer;
buffSz = 2048;
begin begin
if not (poUsePipes in aProcess.Options) then if not (poUsePipes in proc.Options) then
exit; exit;
// //
sum := output.Size; buffSz := proc.PipeBufferSize;
while aProcess.Output.NumBytesAvailable <> 0 do begin sum := stream.Size;
output.SetSize(sum + buffSz); stream.Position := sum;
cnt := aProcess.Output.Read((output.Memory + sum)^, buffSz); repeat
stream.SetSize(sum + buffSz);
cnt := proc.Output.Read((stream.Memory + sum)^, buffSz);
sum += cnt; sum += cnt;
end; until cnt = 0;
output.SetSize(sum); stream.size := sum;
output.Position := sum; stream.Position := sum;
end; end;
procedure killProcess(var aProcess: TAsyncProcess); procedure killProcess(var aProcess: TAsyncProcess);