Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.57 MB
Время: 0.035 c
7-15344
Rem
2002-10-26 16:52
2003.01.06
Установка своей графической оболочки (вместо explorer.exe)


1-15028
alex_ran
2002-12-24 17:11
2003.01.06
Проблема с печатью в FastReport


6-15197
kalishenko
2002-11-08 10:10
2003.01.06
Проблема при ClientSocket1Error


6-15205
X-shadow
2002-11-07 05:47
2003.01.06
Отправка письма


1-15132
Explorer
2002-12-23 10:30
2003.01.06
Работа с датой





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский