Форум: "Основная";
Текущий архив: 2003.01.06;
Скачать: [xml.tar.bz2];

Вниз

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

← →
Азеев Анрей   (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 - нет

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.01.06;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.012 c