Перенаправление вывода внешнего консольного приложения

← →
Азеев Анрей (2002-12-22 23:09) [0]

Нужна консультация. Есть внешнее консольное приложение. Требуется запустить его из моей программы, скрыть консольное окно, а весь вывод перенаправить в TMemo. Я сделал это так:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure ExecWithPipe(FName : PChar);
var
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
Buffer: char;
bRead : DWord;
hRead,hWrite : THandle;
saAttr : TSECURITYATTRIBUTES;
i: integer;
Ln: string;
begin
// Set the bInheritHandle flag so pipe handles are inherited.
saAttr.nLength := sizeof(TSECURITYATTRIBUTES);
saAttr.bInheritHandle := true;
saAttr.lpSecurityDescriptor := nil;

if not CreatePipe(hRead, hWrite,@saAttr,0) then
begin
ShowMessage("Can not create the pipe!");
Exit;
end;

try

FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES or
STARTF_USECOUNTCHARS;
StartupInfo.wShowWindow := SW_HIDE and SW_SHOWMINNOACTIVE;
//Associate our handles with our child process
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.hStdOutput:= hWrite; //we catch output
StartupInfo.hStdError := hWrite; //and also error
StartupInfo.dwXCountChars:=500;
StartupInfo.dwYCountChars:=500;

if not CreateProcess(nil,
FName,
nil, nil,
true, //!!!!!!!we should inherit handles
CREATE_NEW_CONSOLE, //the child should use our CONSOLE
nil, nil, StartupInfo, ProcessInfo) then
ShowMessage("Can not create process")
else
begin
while WaitforSingleObject(ProcessInfo.hProcess,0)
<> WAIT_OBJECT_0 do begin
repeat
if ReadFile(hRead, Buffer, 1, bRead, nil) then
begin
Ln:=Ln+buffer;
If buffer=#10 then
begin
Form1.Memo1.Lines.Add(Ln);
Ln:="";
end else break;
Application.ProcessMessages;
end
else break;
until bRead <> 1 ;
end;
end;
finally
CloseHandle(hRead); CloseHandle(hWrite);
if not FreeConsole then MessageBeep(0);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
CommandLine: string;
begin
CommandLine := "exp userid=system/vivdgego@dez file=backup.dmp log=backuplog.txt grants=y indexes=y rows=y owner=dbg triggers=y constraints=y feedback=100";
ExecWithPipe(PChar(CommandLine));
end;

end.

И все бы хорошо, но по окончании работы этого внешнего приложения все виснет... Что я не так делаю?

← →
Danlicha (2002-12-22 23:20) [1]

У меня не виснет:

function ExecuteProgram(CommandLine: String): String; var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; SecurityAttributes: TSecurityAttributes; OutputR, OutputW, InputR, InputW, ErrorR, ErrorW: THandle; BytesAvailable: DWORD; Read: Cardinal; begin FillChar(StartupInfo, SizeOf(StartupInfo), #0); FillChar(ProcessInfo, SizeOf(ProcessInfo), #0); SecurityAttributes.nLength := SizeOf(SecurityAttributes); SecurityAttributes.lpSecurityDescriptor := nil; SecurityAttributes.bInheritHandle := True; CreatePipe(OutputR, OutputW, @SecurityAttributes, 0); CreatePipe(InputR, InputW, @SecurityAttributes, 0); CreatePipe(ErrorR, ErrorW, @SecurityAttributes, 0); with StartupInfo do begin cb := SizeOf(StartupInfo); dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; wShowWindow := SW_NORMAL; hStdInput := InputR; hStdOutput := OutputW; hStdError := ErrorW; end; if not CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, PChar(ExtractFilePath(MainForm.FileName)), StartupInfo, ProcessInfo) then raise Exception.Create(GetLastWin32ApiErrorMessage); WaitForSingleObject(ProcessInfo.hProcess, INFINITE); CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); PeekNamedPipe(OutputR, nil, 0, nil, @BytesAvailable, nil); if BytesAvailable > 0 then begin SetLength(Result, BytesAvailable); ReadFile(OutputR, Result[1], BytesAvailable, Read, nil); end; CloseHandle(OutputR); CloseHandle(OutputW); CloseHandle(InputR); CloseHandle(InputW); CloseHandle(ErrorR); CloseHandle(ErrorW); end;

← →
Азеев Андрей (2002-12-23 00:12) [2]

Это не совсем то, что мне нужно. Мне необходимо в РЕАЛЬНОМ ВРЕМЕНИ перенаправлять вывод приложения, а не после того как оно отработает.

← →
Danlicha (2002-12-23 01:42) [3]

В таком у Вас не правильно - Вы проверяете WaitforSingleObject, а так нельзя, т.к. к моменту, как в программе дойдёт до этого места, дочерняя ужа могла давно всё вписать в пайп и закрыться. Нужно поток делать. Это только замечание номер один. А ещё пайпы нужно, вроде, все три делать. И освобождать, после того, как станут Вам не нужны, нужно все дескрипторы. Как у меня, в общем.

← →
Song (2002-12-23 08:56) [4]

http://pascal.sources.ru/cgi-bin/forum/YaBB.cgi?board=delphi;action=display;num=1040167706

← →
AlexKr (2002-12-23 14:42) [5]

Вот Ping идет, а exp - нет

Перенаправление вывода внешнего консольного приложения Найти похожие ветки