Browse Source

* patch by Anton Shepelev to pass eofs in tprocess to the parent process, resolves #19325

git-svn-id: trunk@17518 -
florian 14 years ago
parent
commit
fd660355de

+ 1 - 0
.gitattributes

@@ -11501,6 +11501,7 @@ tests/webtbs/tw19277.pp svneol=native#text/pascal
 tests/webtbs/tw1930.pp svneol=native#text/plain
 tests/webtbs/tw1931.pp svneol=native#text/plain
 tests/webtbs/tw1932.pp svneol=native#text/plain
+tests/webtbs/tw19325.pp svneol=native#text/pascal
 tests/webtbs/tw1935.pp svneol=native#text/plain
 tests/webtbs/tw1936.pp svneol=native#text/plain
 tests/webtbs/tw1938.pp svneol=native#text/plain

+ 1 - 1
packages/fcl-process/src/win/pipes.inc

@@ -31,7 +31,7 @@ Const piInheritablePipe : TSecurityAttributes = (
 Function CreatePipeHandles (Var Inhandle,OutHandle : THandle) : Boolean;
 
 begin
-  Result := CreatePipe (@Inhandle,@OutHandle,@piInheritablePipe,PipeBufSize);
+  Result := CreatePipe (@Inhandle,@OutHandle,@piNonInheritablePipe,PipeBufSize);
 end;
 
 

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

@@ -141,13 +141,44 @@ begin
      end;
 end;
 
+{ The handles that are to be passed to the child process must be
+  inheritable. On the other hand, only non-inheritable handles
+  allow the sending of EOF when the write-end is closed. This
+  function is used to duplicate the child process's ends of the
+  handles into inheritable ones, leaving the parent-side handles
+  non-inheritable.
+}
+function DuplicateHandleFP(var handle: THandle): Boolean;
+
+var
+  oldHandle: THandle;
+begin
+  oldHandle := handle;
+  Result := DuplicateHandle
+  ( GetCurrentProcess(),
+    oldHandle,
+    GetCurrentProcess(),
+    @handle,
+    0,
+    true,
+    DUPLICATE_SAME_ACCESS
+  );
+  if Result then
+    Result := CloseHandle(oldHandle);
+end;
+
+
 Procedure CreatePipes(Var HI,HO,HE : Thandle; Var SI : TStartupInfo; CE : Boolean);
 
 begin
   CreatePipeHandles(SI.hStdInput,HI);
+  DuplicateHandleFP(SI.hStdInput);
   CreatePipeHandles(HO,Si.hStdOutput);
-  if CE then
-    CreatePipeHandles(HE,SI.hStdError)
+  DuplicateHandleFP(   Si.hStdOutput);
+  if CE then begin
+    CreatePipeHandles(HE,SI.hStdError);
+    DuplicateHandleFP(   SI.hStdError);
+    end
   else
     begin
     SI.hStdError:=SI.hStdOutput;
@@ -286,6 +317,3 @@ Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
 begin
   FShowWindow:=Value;
 end;
-
-
-

+ 38 - 0
tests/webtbs/tw19325.pp

@@ -0,0 +1,38 @@
+{ %target=win32,win64 }
+Program StrRedir;
+uses Classes, Process, Sysutils;
+const MaxByte = 255;
+type
+      TStrBuf = packed record {As a way to read buffers into strings}
+      case Boolean of
+         true: (  size: Byte;
+                  buf:  array[0..MaxByte] of Char;
+               );
+         false:(  txt:  ShortString;  );
+      end;
+
+var
+   MoreProcess: TProcess;
+   readCount:   integer;
+   strBuf:      TStrBuf;
+
+begin
+   MoreProcess := TProcess.Create(nil);
+   MoreProcess.CommandLine := GetEnvironmentVariable('WINDIR')+'\system32\more.com';
+   MoreProcess.Options := [poUsePipes];
+   MoreProcess.Execute;
+   strBuf.txt := 'Anton';
+   MoreProcess.Input.Write(strBuf.buf, strBuf.size);
+   MoreProcess.CloseInput();
+   writeLn('Waiting...');    //This never ends
+   while MoreProcess.Running do
+   begin
+      Sleep(50);
+      //strBuf.size := MoreProcess.Output.Read(strBuf.buf, 255);
+   end;
+   writeLn('Wait finished.');
+   Sleep(100);
+   strBuf.size := MoreProcess.Output.Read(strBuf.buf, 255);
+   write(strBuf.txt);
+   writeLn('------');
+end.