Я понимаю что перенаправление ввода-вывода консоли это уже затертый до дыр вопрос, но все же есть одна маленькая особенность.
Ситуация следующая: моя задача в том чтобы запустить cmd.exe а дальше исполнять стандартные команды и выводить результат в мемо формы.
Загуглил 0,99 инета нашел кучу примеров с анонимными трубками, но есть одна особенность у них, которая убивает идею их использования на корню. Буферизация вывода. То есть при использовании некоторых приложений (в моем случае gbak (восстановление БД Firebird)) через какоето время вывод начинает буферизироваться, то есть выводит данные пакетами. Не знаю уж кто виноват, ось, дельфи или Ктулху. Находил несколько веток с похожей проблемой, но нигде не нашел решения. На этом форуме в похожей ветке наткнулся на идею использования именнованных трубок. Начал курить эту тему. Вот до чего докурился.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
StopFlag:boolean;
public
procedure PipeExecute;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.PipeExecute;
var vSecurityAttr:TSecurityAttributes;
hReadIn, hWriteOut:THandle;
hReadOut, hWriteIn:THandle;
vStartUpInfo:TStartUpInfo;
vProcessInfo:TProcessInformation;
vReadBuf:PAnsiChar;
vReadBytes:Cardinal;
vBufBytes:Cardinal;
vCmd:PAnsiChar;
const cReadBufSize = 1024;
begin
vCmd:=PAnsiChar(Copy('ping www.ya.ru -t', 1, 20));
with vSecurityAttr do
begin
nLength:=SizeOf(TSecurityAttributes);
bInheritHandle:=true;
lpSecurityDescriptor:=nil;
end;
////
hReadOut := CreateNamedPipeW ('\\.\PIPE\Out',
PIPE_ACCESS_DUPLEX,
PIPE_WAIT or
PIPE_READMODE_BYTE or
PIPE_TYPE_BYTE,
100,
cReadBufSize,
cReadBufSize,
5000,
@vSecurityAttr);
hWriteOut:=CreateFileW ('\\.\PIPE\Out',
GENERIC_WRITE or
GENERIC_READ,
FILE_SHARE_READ or
FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
FILE_FLAG_NO_BUFFERING,
0);
//}
// CreatePipe(hReadOut, hWriteOut, @vSecurityAttr, 0);
vReadBuf:=AllocMem(cReadBufSize+1);
FillChar(vStartUpInfo, Sizeof(vStartUpInfo), #0);
with vStartUpInfo do
begin
cb:=SizeOf(vStartUpInfo);
hStdOutput:=hWriteOut;
hStdError:=hWriteOut;
hStdInput:=GetStdHandle(STD_INPUT_HANDLE);
dwFlags:=STARTF_USESTDHANDLES+STARTF_USESHOWWINDOW;
wShowWindow:=SW_SHOW;
end;
if (CreateProcess(nil, PChar(vCmd), nil, nil, true, CREATE_NEW_CONSOLE, nil, nil, vStartUpInfo, vProcessInfo)) then
begin
try
repeat
ReadFile(hReadOut, vReadBuf[0], cReadBufSize, vReadBytes, nil);
vReadBuf[vReadBytes]:=#0;
OemToAnsi(vReadBuf, vReadBuf);
Memo1.Lines[Memo1.Lines.Count-1]:=Memo1.Lines[Memo1.Lines.Count-1]+String(vReadBuf);
Application.ProcessMessages;
until not StopFlag;
finally
TerminateProcess(vProcessInfo.hProcess, 1);
CloseHandle(vProcessInfo.hThread);
CloseHandle(vProcessInfo.hProcess);
CloseHandle(hReadOut);
CloseHandle(hWriteIn);
FreeMem(vReadBuf);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
StopFlag:=not StopFlag;
if StopFlag then
PipeExecute;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StopFlag:=false;
end;
end.
Код естественно кривоват без проверок и прочего барахла, но почти рабочий )
При использовании анонимных трубок (которые закоментированы) все нормально работает. Переключаюсь на именнованные, приложение стопорится изза того что в трубку не поступают данные.
Подскажите пожалуйста где косяк?