Форум: "WinAPI";
Текущий архив: 2011.02.13;
Скачать: [xml.tar.bz2];

Вниз

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

← →
SpellCaster   (2009-06-17 19:04) [0]

Всем привет!
Задача: запускать из gui приложения различные консольные программы, в том числе батники, с возможностью посмотреть, что они выводят на консоль, и в то же время записью всего этого в файл.

Что пробовал:
1) Перенаправление input и output на неименованные пайпы. Всё прекрасно, но вывод прог типа wget вообще не ловится. Также у многих прог наблюдается задержка вывода в связи с буферизацией printf

2) Использование собственной консоли, создаваемой через AllocConsole. Тоже неплохо, сделал, чтобы она пряталась и показывалась, с закрытием проги при закрытии консоли тоже можно смириться, но! Никак не пойму, как прочитать оттуда выводимую информацию, чтобы сохранять ее в файл. Пробовал делать ReadFile(GetStdHandle(STD_OUTPUT_HANDLE)), но не сработало. Видимо, считывать инфу можно только через буфер, посредством ReadConsoleOutputCharacter? Но тогда возникают некоторые заморочки с синхронизацией (как определить, до какой позиции считывать, когда очищать, вдруг за это время запущенная прога еще что-то напишет и т.п.)

На крайний случай есть вариант сделать прогу-заглушку, но он мне не нравится. Есть у кого-нибудь идеи, как можно решить данную проблему?

---

← →
SpellCaster   (2009-06-17 19:08) [1]

Как мне кажется, проблему синхронизации можно решить, тормозя поток дочерней программы на время считывания буфера. Не очень надежное решение, но лучше повышения приоритета родительского процесса до критического, которое предлагают вот здесь http://www.codeproject.com/KB/threads/RTconsole.aspx

---

← →
Игорь Шевченко ©   (2009-06-17 19:54) [2]

> 1) Перенаправление input и output на неименованные пайпы


еще можно stderror перенаправлять

---

← →
SpellCaster   (2009-06-18 10:09) [3]

Это понятно, хотя я не думаю, что именно туда пишется основная инфа, выводимая программой.

Ну так что по поводу вопроса? Кто-то может что-нибудь посоветовать?

---

← →
Медвежонок Пятачок ©   (2009-06-18 11:25) [4]

Никак не пойму, как прочитать оттуда выводимую информацию, чтобы сохранять ее в файл. Пробовал делать ReadFile(GetStdHandle(STD_OUTPUT_HANDLE)), но не сработало.

Создаем консоль.
Полученный хендл передаем в параметрах CreateProcess.
Дальше читаем оттуда.

---

← →
SpellCaster   (2009-06-18 11:35) [5]

> [4] Медвежонок Пятачок ©   (18.06.09 11:25)

Читаем откуда?
 h := GetStdHandle(STD_OUTPUT_HANDLE);
 si.hStdOutput := h
 CreateProcess(...)
 ReadFile(h, buf, 1024, bytesread, nil);
вот так?

---

← →
Медвежонок Пятачок ©   (2009-06-18 11:50) [6]

Причем здесь GetStdHandle?

Ты же консоль явно создаешь.

---

← →
SpellCaster   (2009-06-18 12:53) [7]

Тогда я не понимаю, к чему относятся слова
> Полученный хендл

---

← →
Медвежонок Пятачок ©   (2009-06-18 13:02) [8]

сначала создаешь устройства ввода/вывода для стартуемого консольного процесса.
таким образом хендлы у тебя есть.
затем делаешь createprocess, передавая хендлы новому процессу.
после этого его инпут-аутпут операции будут работать с переданными хендлами.

---

← →
Eraser ©   (2009-06-18 13:04) [9]

держи
unit ConsoleRedirect;

interface

uses
 Classes, Windows, SyncObjs;

type
 TConsoleRedirector = class(TThread)
 private
   { Private declarations }
   FErrorCode: Integer;
   FCmdPath: string;
   FSendCmd: AnsiString;
   FOutput: AnsiString;
   FLocker: TCriticalSection;

   procedure OutputLines(const AText: AnsiString);
   //procedure InprocessDuplicateHandle(Source: THandle; var Destination: THandle);
 protected
   procedure Execute; override;
 public
   constructor Create(); reintroduce; overload;
   destructor Destroy; override;
   procedure SendBuff(const AText: AnsiString);

   property Terminated;
   property Locker: TCriticalSection read FLocker write FLocker;
   property SendCmd: AnsiString read FSendCmd write FSendCmd;
   property Output: AnsiString read FOutput write FOutput;
 end;

implementation

uses
 SysUtils;

const
 CRLF = #13#10;

{ TConsoleRedirector }

constructor TConsoleRedirector.Create;
var
 pch: PChar;
begin
 inherited Create(True);

 FLocker := TCriticalSection.Create;

 // Извлечем путь к системному каталогу.
 GetMem(pch, MAX_PATH);
 try
   GetSystemDirectory(pch, MAX_PATH);
   FCmdPath := pch;
   UniqueString(FCmdPath);
 finally
   FreeMem(pch);
 end;

 FCmdPath := IncludeTrailingPathDelimiter(FCmdPath) + "cmd.exe";
 //OutputDebugString(PChar(FCmdPath));
end;

destructor TConsoleRedirector.Destroy;
begin
 FLocker.Free;

 inherited Destroy;
end;

procedure TConsoleRedirector.Execute;
const
 BufSize = 512;
var
 Buf: array[0..BufSize - 1] of AnsiChar;
 sInternalBuff: AnsiString;
 si: TStartupInfo;
 sa: SECURITY_ATTRIBUTES;
 pi: TProcessInformation;
 hNewStdIn, hNewStdOut, hReadStdOut, hWriteStdIn: THandle;
 bread, avail, cExitCode: Cardinal;
begin
 //FreeOnTerminate := True;
 FErrorCode := 0;

 if Win32Platform = VER_PLATFORM_WIN32_NT then
 begin
   sa.nLength := SizeOf(SECURITY_ATTRIBUTES);
   sa.bInheritHandle := True;
   sa.lpSecurityDescriptor := nil;
 end
 else
 begin
   sa.lpSecurityDescriptor := nil;
 end;

 // Проинициализируем переменные.
 hNewStdIn := 0;
 hNewStdOut := 0;
 hReadStdOut := 0;
 hWriteStdIn := 0;
 FillChar(si, SizeOf(TStartupInfo), 0);
 FillChar(pi, SizeOf(TProcessInformation), 0);
 
 try
   // Создаем первый анонимный пайп.
   if not CreatePipe(hNewStdIn, hWriteStdIn, @sa, 0) then
   begin
     FErrorCode := 1;
     Exit;
   end;

   SetHandleInformation(hWriteStdIn, HANDLE_FLAG_INHERIT, 0);

   // Создаем второй анонимный пайп.
   if not CreatePipe(hReadStdOut, hNewStdOut, @sa, 0) then
   begin
     FErrorCode := 1;
     Exit;
   end;

   SetHandleInformation(hReadStdOut, HANDLE_FLAG_INHERIT, 0);

   si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
   si.wShowWindow := SW_HIDE;
   si.hStdOutput := hNewStdOut;
   si.hStdError := hNewStdOut;
   si.hStdInput := hNewStdIn;

   // Пытаемся запустить процесс.
   if not CreateProcess(PChar(FCmdPath), nil, nil, nil, True,
     CREATE_NEW_CONSOLE, nil, nil, si, pi) then
   begin
     //MessageBox(0, PChar("error CreateProcess #" + IntToStr(GetLastError)), nil, MB_OK);
     FErrorCode := 2;
     Exit;
   end;

   CloseHandle(pi.hThread);

   FillChar(Buf, SizeOf(Buf), 0);

   while not Terminated do
   begin
     Sleep(10);
     GetExitCodeProcess(pi.hProcess, cExitCode);

     if cExitCode <> STILL_ACTIVE then
     begin
       FErrorCode := 3;
       //MessageBox(0, PChar("exit #" + IntToStr(cExitCode)), nil, MB_OK);
       Exit;
     end;

     PeekNamedPipe(hReadStdOut, @Buf, BufSize, @bread, @avail, nil);

     // Данные есть, считываем.
     while bread <> 0 do
     begin
       FillChar(Buf, BufSize, 0);
       if avail > BufSize then
       begin
         while bread >= bufsize do
         begin
           ReadFile(hReadStdOut, Buf, BufSize, bread, nil);
           sInternalBuff := sInternalBuff + Buf;
           FillChar(Buf, BufSize, 0);
         end;
       end
       else
       begin
         ReadFile(hReadStdOut, Buf, BufSize, bread, nil);
         sInternalBuff := sInternalBuff + Buf;
       end;

       PeekNamedPipe(hReadStdOut, @Buf, BufSize, @bread, @avail, nil);
     end;

     FLocker.Enter;
     try
       if sInternalBuff <> "" then
       begin
         // Запишем данные из внутреннего буффера во внешний.
         OutputLines(sInternalBuff);
         sInternalBuff := "";
       end;

       // Записываем данные ввода, если они есть, посимвольно.
       sInternalBuff := FSendCmd;
       while Length(sInternalBuff) > 0 do
       begin
         WriteFile(hWriteStdIn, sInternalBuff[1], 1, bread, nil);
         Delete(sInternalBuff, 1, 1);
       end;

       sInternalBuff := "";
       FSendCmd := "";
     finally
       FLocker.Leave;
     end;
   end;
 finally
   if hNewStdIn <> 0 then
     CloseHandle(hNewStdIn);
   if hNewStdOut <> 0 then
     CloseHandle(hNewStdOut);
   if hReadStdOut <> 0 then
     CloseHandle(hReadStdOut);
   if hWriteStdIn <> 0 then
     CloseHandle(hWriteStdIn);

   // Остановим процесс.
   if pi.hProcess <> 0 then
   begin
     TerminateProcess(pi.hProcess, 0);
   end;

   //if pi.hThread <> 0 then
   //  CloseHandle(pi.hThread);
   if pi.hProcess <> 0 then
     CloseHandle(pi.hProcess);
 end;
end;

{
procedure TConsoleRedirector.InprocessDuplicateHandle(Source: THandle;
 var Destination: THandle);
var
 CurrentProcess: THandle;
begin
 CurrentProcess := GetCurrentProcess;
 DuplicateHandle(
   CurrentProcess,
   Source,
   CurrentProcess,
   @Destination,
   0, False, DUPLICATE_SAME_ACCESS);
end;
}

procedure TConsoleRedirector.OutputLines(const AText: AnsiString);
var
 sText: AnsiString;
begin
 sText := AText;

 sText := AnsiString(StringReplace(string(sText), #13#13#10, #13, [rfReplaceAll]));

 FOutput := FOutput + sText;
end;

procedure TConsoleRedirector.SendBuff(const AText: AnsiString);
begin
 FLocker.Enter;
 try
   FSendCmd := FSendCmd + AText + CRLF;
 finally
   FLocker.Leave;
 end;
end;

end.

---

← →
SpellCaster   (2009-06-18 13:41) [10]

> [8] Медвежонок Пятачок ©   (18.06.09 13:02)

Извини, я не понимаю, можешь на пальцах?

> [9] Eraser ©   (18.06.09 13:04)

Не запускает батник... пишет
Microsoft Windows XP [Версия 5.1.2600](С)
Корпорация Майкрософт, 1985-2001.

D:\Coding\Projects\Delphi\!Test\Test>
и все

---

← →
SpellCaster   (2009-06-18 15:16) [11]

а еще, зачем SetHandleInformation(hWriteStdIn, HANDLE_FLAG_INHERIT, 0); ? Неужели признака в TSecurityAttributes недостаточно?

---

← →
SpellCaster   (2009-06-18 17:51) [12]

Получилось-таки!!! Сделал вот так:


var hReadPipe: THandle = 0;
   hWritePipe: THandle = 0;
   hProc: THandle = 0;
   buf: array [0..1023] of char;

// test console output redirecting
procedure TForm1.Button2Click(Sender: TObject);
var si: TStartupInfo;
   pi: TProcessInformation;
   sa: TSecurityAttributes;
   dir: string;
   bytesread: cardinal;
   h: thandle;
   space: integer;
begin
 FillChar(sa, SizeOf(sa), 0);
 sa.nLength := SizeOf(sa);
 sa.lpSecurityDescriptor := nil;
 sa.bInheritHandle := True;
 if not CreatePipe(hReadPipe, hWritePipe, @sa, 0) then
   Error(LastErrMsg);

 FillChar(si, SizeOf(si), 0);
 FillChar(pi, SizeOf(pi), 0);
 si.cb := SizeOf(si);
 si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
 si.wShowWindow := SW_HIDE;
 si.hStdOutput := hWritePipe;
 si.hStdError := hWritePipe;
 // определяем рабочую директорию, если в батнике относительные пути - ненадежно!! не учитывает пробелы в пути
 space := Pos(" ",edit4.Text);
 if space = 0 then space := Length(edit4.Text)+1;
 dir := ExtractFilePath(Copy(edit4.Text,1,space-1));
 if dir = "" then dir := ExtractFilePath(Application.ExeName);

 if not CreateProcess(nil,PChar(edit4.Text),@sa,nil,True,0,nil,PChar(dir),si,pi)
   then Error(LastErrMsg)
   else memo2.Lines.Add(">process launched");
 hProc := pi.hProcess;

 CloseHandle(pi.hThread);
 timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var bytesread, cExitcode: cardinal;
begin
 if (hProc = 0) or (hWritePipe = 0) or (hReadPipe = 0) then Exit;

 if (not GetExitCodeProcess(hProc, cExitcode)) or (cExitcode <> STILL_ACTIVE)
   then begin CloseHandle(hProc); hProc := 0; end;

 repeat
   PeekNamedPipe(hReadPipe, nil, 0, nil, @bytesread, nil);
   if bytesread = 0 then
   begin
     if hProc = 0 then CloseHandle(hReadPipe);
     Break;
   end;
   FillChar(buf, SizeOf(buf), 0);
   if not ReadFile(hReadPipe, buf, 1024, bytesread, nil) then
     begin Timer1.Enabled := False; Error(LastErrMsg); end;
   OemToAnsi(buf,buf);
   if bytesread > 0 then
     memo2.Text:=memo2.Text+(pchar(@buf));
   sendmessage(memo2.Handle, WM_VSCROLL, SB_BOTTOM, 0);
 until bytesread = 0;

 if hProc = 0 then
   memo2.Lines.Add(">process exited");
end;

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

---

← →
Slym ©   (2009-06-18 19:16) [13]

Удалено модератором
Примечание: Не в пивной

---

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

Форум: "WinAPI";
Текущий архив: 2011.02.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.003 c