procedure TStdIORedirect.CreateHandles; var sa :TSecurityAttributes; hOutputReadTmp,hErrorReadTmp,hInputWriteTmp:THandle; begin DestroyHandles; sa.nLength := sizeof(sa); sa.lpSecurityDescriptor := Nil; sa.bInheritHandle := True; if not CreatePipe(hOutputReadTmp,fOutputWrite,@sa,0) then RaiseLastWin32Error; if not CreatePipe(hErrorReadTmp,fErrorWrite,@sa,0) then RaiseLastWin32Error; if not CreatePipe(fInputRead,hInputWriteTmp,@sa,0) then RaiseLastWin32Error; if not DuplicateHandle(GetCurrentProcess,hOutputReadTmp,GetCurrentProcess,@fOutputRead,0,FALSE,DUPLICATE_SAME_ACCESS) then RaiseLastWin32Error; if not DuplicateHandle(GetCurrentProcess,hErrorReadTmp,GetCurrentProcess,@fErrorRead,0,FALSE,DUPLICATE_SAME_ACCESS) then RaiseLastWin32Error; if not DuplicateHandle(GetCurrentProcess,hInputWriteTmp,GetCurrentProcess,@fInputWrite,0,FALSE,DUPLICATE_SAME_ACCESS) then RaiseLastWin32Error; CloseHandle(hOutputReadTmp); CloseHandle(hErrorReadTmp); CloseHandle(hInputWriteTmp); fOutputStream := TMemoryStream.Create; fErrorStream := TMemoryStream.Create; fOutputStreamPos := 0; fErrorStreamPos := 0; fOutputText.Clear; fErrorText.Clear; end; destructor TStdIORedirect.Destroy; begin DestroyHandles; fOutputText.Free; fErrorText.Free; fInputEvent.Free; fInputText.Free; inherited; end;
procedure TStdIORedirect.DestroyHandles; begin if fInputRead <> 0 then CloseHandle(fInputRead); if fOutputRead<> 0 then CloseHandle(fOutputRead); if fErrorRead <> 0 then CloseHandle(fErrorRead); if fInputWrite<> 0 then CloseHandle(fInputWrite); if fOutputWrite<>0 then CloseHandle(fOutputWrite); if fErrorWrite<>0 then CloseHandle(fErrorWrite); fInputRead := 0; fOutputRead := 0; fErrorRead := 0; fInputWrite := 0; fOutputWrite := 0; fErrorWrite := 0; fErrorStream.Free; fErrorStream := Nil; fOutputStream.Free; fOutputStream := Nil; end;
procedure TStdIORedirect.HandleOutput; var ch:char; begin fOutputStream.Position := fOutputStreamPos; while fOutputStream.Position < fOutputStream.Size do begin fOutputStream.Read(ch,sizeof(ch)); case ch of #13:begin fOutputText.Add(fOutputLineBuff); if Assigned(OnOutputText) then OnOutputText(self,fOutputLineBuff); fOutputLineBuff := ''; end; #0..#12, #14..#31 :; else fOutputLineBuff := fOutputLineBuff + ch end end; fOutputStreamPos := fOutputStream.Position; fErrorStream.Position := fErrorStreamPos; while fErrorStream.Position < fErrorStream.Size do begin fErrorStream.Read (ch,sizeof(ch)); case ch of #13:begin fErrorText.Add(fErrorLineBuff); if Assigned(OnErrorText) then OnErrorText(self,fErrorLineBuff); fErrorLineBuff := ''; end; #0..#12, #14..#31 :; else fErrorLineBuff := fErrorLineBuff + ch end end; fErrorStreamPos := fErrorStream.Position; end;
procedure TStdIORedirect.PrepareStartupInformation( var info:TStartupInfo); begin info.cb := sizeof(info); info.dwFlags := info.dwFlags or STARTF_USESTDHANDLES; info.hStdInput := fInputRead; info.hStdOutput := fOutputWrite; info.hStdError := fErrorWrite; end;
procedure TStdIORedirect.Run(fileName,cmdLine,directory:string); var startupInfo :TStartupInfo; pOK :boolean; fName,cLine,dir:PChar; begin if not Running then begin FillChar(startupInfo,sizeof(StartupInfo),0); CreateHandles; PrepareStartupInformation (startupInfo); if fileName<>''then fName := PChar(fileName) else fName := Nil; if cmdLine <>''then cLine := PChar(cmdLine) else cLine := Nil; if directory <>''then dir := PChar(directory) else dir := Nil; pOK := CreateProcess(fName,cLine,Nil,Nil,True,CREATE_NO_WINDOW,Nil,dir,startupInfo,fProcessInfo); CloseHandle (fOutputWrite); fOutputWrite := 0; CloseHandle(fInputRead); fInputRead := 0; CloseHandle(fErrorWrite); fErrorWrite := 0; if pOK then begin fRunning := True; try TStdIOInputThread.Create(self); TStdIOOutputThread.Create(self); while MsgWaitForMultipleObjects(1,fProcessInfo.hProcess,False,INFINITE,QS_ALLINPUT)= WAIT_OBJECT_0 + 1 do Application.ProcessMessages; if not GetExitCodeProcess (fProcessInfo.hProcess,fReturnValue) then RaiseLastWin32Error; finally fInputText.Clear; CloseHandle(fProcessInfo.hThread); CloseHandle(fProcessInfo.hProcess); fRunning := False; if Assigned(OnTerminate) then OnTerminate(self); end; end else RaiseLastWin32Error end end;
procedure TStdIORedirect.Terminate; begin if Running then TerminateProcess(fProcessInfo.hProcess,0); end;
function CopyTextToPipe(handle:THandle;text:TStrings):boolean; var i :Integer; st :string; bytesWritten :DWORD; p :Integer; bTerminate :boolean; begin bTerminate := False; for i := 0 to text.Count-1 do begin st := text[i]; p := Pos(#26,st); if p > 0 then begin st := Copy(st,1,p - 1); bTerminate := True; end else st := st + #13#10; if st<> ''then if not WriteFile(handle,st[1],Length(st),bytesWritten,Nil) then if GetLastError <> ERROR_NO_DATA then RaiseLastWin32Error; end; result := bTerminate; text.Clear end;
procedure TStdIOInputThread.Execute; var objects :array[0..1]of THandle; objectNo :DWORD; begin if fParent.fInputText.Count > 0 then fParent.fInputEvent.SetEvent; objects[0]:= fParent.fProcessInfo.hProcess; objects [1]:= fParent.fInputEvent.Handle; while True do begin objectNo := WaitForMultipleObjects(2,@objects[0],False,INFINITE); case objectNo of WAIT_OBJECT_0 + 1 : if CopyTextToPipe (fParent.fInputWrite,fParent.fInputText) then begin CloseHandle (fParent.fInputWrite); fParent.fInputWrite := 0; break end; else break; end end end;
procedure TStdIOOutputThread.Execute; var buffer:array[0..1023]of char; bytesRead :DWORD; begin while ReadFile(fParent.fOutputRead,buffer,1024,bytesRead,Nil)and(bytesRead > 0) do begin fParent.fOutputStream.Seek(0,soFromEnd); fParent.fOutputStream.Write(buffer[0],bytesRead); Synchronize(fParent.HandleOutput) end end;
{ *==========* | StdIORedirect | | Component to get output from and provide input to command line apps | | Copyright (C) Colin Wilson 1999. All rights reserved | | Public methods and properties: | | procedure Run (fileName, cmdLine, directory : string); | | Run a program with redirected output | | procedure AddInputText (const st : string); | | Add a line of text to be sent to the application's STDIN | | procedure Terminate; | | Terminate the program started with 'Run' | | property ReturnValue : DWORD read fReturnValue; property OutputText : TStrings read fOutputText; property ErrorText : TStrings read fErrorText; property Running : boolean read fRunning;
destructor TStdIORedirect.Destroy; begin DestroyHandles; fOutputText.Free; fErrorText.Free; fInputEvent.Free; fInputText.Free; inherited; end;
procedure TStdIORedirect.DestroyHandles; begin if fInputRead <> 0 then CloseHandle(fInputRead); if fOutputRead <> 0 then CloseHandle(fOutputRead); if fErrorRead <> 0 then CloseHandle(fErrorRead);
if fInputWrite <> 0 then CloseHandle(fInputWrite); if fOutputWrite <> 0 then CloseHandle(fOutputWrite); if fErrorWrite <> 0 then CloseHandle(fErrorWrite);
procedure TStdIORedirect.HandleOutput; var ch: char; begin fOutputStream.Position := fOutputStreamPos;
while fOutputStream.Position < fOutputStream.Size do begin fOutputStream.Read(ch, sizeof(ch)); case ch of #13: begin fOutputText.Add(fOutputLineBuff); if Assigned(OnOutputText) then OnOutputText(self, fOutputLineBuff); fOutputLineBuff := ''; end;
#0 .. #12, #14 .. #31: ;
else fOutputLineBuff := fOutputLineBuff + ch end end;
fOutputStreamPos := fOutputStream.Position;
fErrorStream.Position := fErrorStreamPos;
while fErrorStream.Position < fErrorStream.Size do begin fErrorStream.Read(ch, sizeof(ch)); case ch of #13: begin fErrorText.Add(fErrorLineBuff); if Assigned(OnErrorText) then OnErrorText(self, fErrorLineBuff); fErrorLineBuff := ''; end;
#0 .. #12, #14 .. #31: ;
else fErrorLineBuff := fErrorLineBuff + ch end end;
procedure TStdIORedirect.Run(fileName, cmdLine, directory: string); var startupInfo: TStartupInfo; pOK: boolean; fName, cLine, dir: PChar; begin if not Running then begin FillChar(startupInfo, sizeof(startupInfo), 0); CreateHandles; PrepareStartupInformation(startupInfo);
if fileName <> '' then fName := PChar(fileName) else fName := Nil; if cmdLine <> '' then cLine := PChar(cmdLine) else cLine := Nil; if directory <> '' then dir := PChar(directory) else dir := Nil;
if pOK then begin fRunning := True; try TStdIOInputThread.Create(self); TStdIOOutputThread.Create(self); while MsgWaitForMultipleObjects(1, fProcessInfo.hProcess, False, INFINITE, QS_ALLINPUT) = WAIT_OBJECT_0 + 1 do Application.ProcessMessages;
if not GetExitCodeProcess(fProcessInfo.hProcess, fReturnValue) then RaiseLastWin32Error;
finally fInputText.Clear; CloseHandle(fProcessInfo.hThread); CloseHandle(fProcessInfo.hProcess); fRunning := False; if Assigned(OnTerminate) then OnTerminate(self); end; end else RaiseLastWin32Error end end;
procedure TStdIORedirect.Terminate; begin if Running then TerminateProcess(fProcessInfo.hProcess, 0); end;
function CopyTextToPipe(handle: THandle; text: TStrings): boolean; var i: Integer; st: string; bytesWritten: DWORD; p: Integer; bTerminate: boolean; begin bTerminate := False; for i := 0 to text.Count - 1 do begin st := text[i]; p := Pos(#26, st); if p > 0 then begin st := Copy(st, 1, p - 1); bTerminate := True; end else st := st + #13#10;
if st <> '' then if not WriteFile(handle, st[1], Length(st), bytesWritten, Nil) then if GetLastError <> ERROR_NO_DATA then RaiseLastWin32Error;
end; result := bTerminate; text.Clear end;
procedure TStdIOInputThread.Execute; var objects: array [0 .. 1] of THandle; objectNo: DWORD; begin if fParent.fInputText.Count > 0 then fParent.fInputEvent.SetEvent;
while True do begin objectNo := WaitForMultipleObjects(2, @objects[0], False, INFINITE);
case objectNo of WAIT_OBJECT_0 + 1: if CopyTextToPipe(fParent.fInputWrite, fParent.fInputText) then begin CloseHandle(fParent.fInputWrite); fParent.fInputWrite := 0; break end; else break; end end end;
procedure TStdIOOutputThread.Execute; var buffer: array [0 .. 1023] of char; bytesRead: DWORD;
begin while ReadFile(fParent.fOutputRead, buffer, 1024, bytesRead, Nil) and (bytesRead > 0) do begin fParent.fOutputStream.Seek(0, soFromEnd); fParent.fOutputStream.Write(buffer[0], bytesRead); Synchronize(fParent.HandleOutput) end end;