Browse Source

* wait up to 10ms extra till process really done to get rest of input, closes #39821
* avoid closing a popassinput handle.

marcoonthegit 3 years ago
parent
commit
d347487be9
2 changed files with 10 additions and 1 deletions
  1. 5 1
      packages/fcl-process/src/pipes.pp
  2. 5 0
      packages/fcl-process/src/win/process.inc

+ 5 - 1
packages/fcl-process/src/pipes.pp

@@ -44,10 +44,13 @@ Type
     end;
 
   TOutputPipeStream = Class(THandleStream)
+    private
+      FDontClose :  boolean;
     Public
       destructor Destroy; override;
       function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
       Function Read (Var Buffer; Count : Longint) : longint; Override;
+      property DontClose :  boolean read FDontClose write FDontClose;
     end;
 
 Function CreatePipeHandles (Var Inhandle,OutHandle : THandle; APipeBufferSize : Cardinal = 1024) : Boolean;
@@ -126,7 +129,8 @@ end;
 
 destructor TOutputPipeStream.Destroy;
 begin
-  PipeClose (Handle);
+  if not fdontclose then
+    PipeClose (Handle);
   inherited;
 end;
 

+ 5 - 0
packages/fcl-process/src/win/process.inc

@@ -39,6 +39,9 @@ end;
 Function TProcessnamemacro.PeekExitStatus : Boolean;
 begin
   Result:=GetExitCodeProcess(ProcessHandle,FExitCode) and (FExitCode<>Still_Active);
+  // wait up to 10ms extra till process really done to get rest of input bug #39821
+  if not Result Then
+    WaitForSingleObject(FProcessHandle,10);
 end;
 
 Function GetStartupFlags (P : TProcessnamemacro): Cardinal;
@@ -296,6 +299,8 @@ Var
         if Not (poStdErrToOutPut in Options) then
           FileClose(FStartupInfo.hStdError);
         CreateStreams(HI,HO,HE);
+        if poPassInput in Options then
+           FInputStream.DontClose:=true;
         end;
     end;
     FRunning:=True;