Перенаправление I/O консоли с помощью именнованных трубок.

Gorilka
Дата: 18.06.2009 13:30:33
Я понимаю что перенаправление ввода-вывода консоли это уже затертый до дыр вопрос, но все же есть одна маленькая особенность.

Ситуация следующая: моя задача в том чтобы запустить 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.
Код естественно кривоват без проверок и прочего барахла, но почти рабочий )

При использовании анонимных трубок (которые закоментированы) все нормально работает. Переключаюсь на именнованные, приложение стопорится изза того что в трубку не поступают данные.

Подскажите пожалуйста где косяк?
Dimitry Sibiryakov
Дата: 18.06.2009 13:52:05

Gorilka

Буферизация вывода. То есть при использовании некоторых приложений (в
моем случае gbak (восстановление БД Firebird)) через какоето время вывод
начинает буферизироваться, то есть выводит данные пакетами.

Нет чтобы взять и поправить этот самый gbak, чтобы он делал flush()
после вывода если пишет не в файл... Как это сделано в isql...

Posted via ActualForum NNTP Server 1.4

Gorilka
Дата: 18.06.2009 14:40:59
Такое решение не подойдет, менять gbak у огромного количества клиентов не выход и потенциальная дыра с бесчисленным количеством звонков аля "У нас все работает черз Ж." Потому реализация должна быть полностью на стандартном сервере со стандартными установками.
Dimitry Sibiryakov
Дата: 18.06.2009 14:44:05

Gorilka

Потому реализация должна быть полностью на стандартном сервере со
стандартными установками.

Тогда Services API тебе в руки. У них вывод практически не буферизуется.

Posted via ActualForum NNTP Server 1.4

Barmaley57
Дата: 18.06.2009 14:48:04
В твоем примере вызов ReadFile терпит неудачу с ошибкой "идет ожидание открытия процессом другой стороны канала". Что это значит я не знаю. Видать надо курить именованные каналы дальше, ибо запускаемый процесс не может его открыть...
Barmaley57
Дата: 18.06.2009 14:58:10
Вроде работает...

procedure TForm1.PipeExecute;
var vSecurityAttr:TSecurityAttributes;
    hReadIn, hWriteOut:THandle;
    hReadOut, hWriteIn:THandle;
    vStartUpInfo:TStartUpInfo;
    vProcessInfo:TProcessInformation;
    vReadBuf:PChar;
    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;

  hWriteOut := CreateNamedPipe('\\.\PIPE\Out',
    PIPE_ACCESS_DUPLEX,
    PIPE_WAIT or
    PIPE_TYPE_BYTE,
    100,
    cReadBufSize,
    cReadBufSize,
    5000,
    @vSecurityAttr);

    hReadOut:=CreateFile('\\.\PIPE\Out',
    GENERIC_WRITE or
    GENERIC_READ,
    FILE_SHARE_READ or
    FILE_SHARE_WRITE,
    nil,
    OPEN_EXISTING,
    FILE_FLAG_NO_BUFFERING,
    0);

  GetMem(vReadBuf,cReadBufSize+1);

  GetStartupInfo(vStartUpInfo);

  with vStartUpInfo do
  begin
    cb:=SizeOf(vStartUpInfo);
    hStdOutput:=hWriteOut;
    hStdError:=hWriteOut;
    hStdInput:=GetStdHandle(STD_INPUT_HANDLE);
    dwFlags:=STARTF_USESTDHANDLES+STARTF_USESHOWWINDOW;
    wShowWindow:=SW_HIDE;
  end;

  if (CreateProcess(nil, PChar(vCmd), nil, nil, true, CREATE_NEW_CONSOLE, nil, nil, vStartUpInfo, vProcessInfo)) then
  begin
    if not ReadFile(hReadOut,vReadBuf^, cReadBufSize, vReadBytes, nil) then
      ShowMessage(SysErrorMessage(GetLastError));
    vReadBuf[vReadBytes]:=#0;
    OemToAnsi(vReadBuf, vReadBuf);
    Memo1.Lines[Memo1.Lines.Count-1]:=Memo1.Lines[Memo1.Lines.Count-1]+String(vReadBuf);
    Application.ProcessMessages;

    TerminateProcess(vProcessInfo.hProcess, 1);
    CloseHandle(vProcessInfo.hThread);
    CloseHandle(vProcessInfo.hProcess);
    CloseHandle(hReadOut);
    FreeMem(vReadBuf);
  end;
end;
Gorilka
Дата: 18.06.2009 15:03:25
В Api бы тоже лезть не хотелось.
Не совсем улавливаю почему вы упираете именно на изменение gbak?
В абсолютно похожей теме была аналогичная проблема с другой программой и вы говорили о том что буферизацию производит система, а Анатолий намекнул что использование именнованных трубок это дело может поправить. Вот я и пошел по этому пути.
Gorilka
Дата: 18.06.2009 15:07:49
Barmaley, спасибо, у меня тоже заработало, пойду курить дальше.
Barmaley57
Дата: 18.06.2009 15:08:44
Вообще, насколько я себе представляю работу оси, с буферизацией в том или ином виде, работает почти все. Тем более ReadFile, WriteFile. Тут надо тогда определиться, что здесь понимается под буферизацией? Кэширование системой или что-то еще?
Gorilka
Дата: 18.06.2009 15:13:07
Ну насколько я сумел разобраться в вопросе по разным топикам, буферизует действительно именно система гдето между выводом консоли и вводом в хэндл трубки, который можно расценивать как файл. Но при этом именнованные трубки позволяют задавать параметр FILE_FLAG_NO_BUFFERING который в теории эту буферизацию должен глушить. По крайней мере это то как я себе представляю.