получить вывод другой программы

[Attid]

как получить вывод другой программы ?
можно запустить с перевыводом в файл, и его отпарсить, но должно быть что-то проще =)

[ev]

вот наткнулся на примерчик где-то (в инете или еще где - не помню уже), но сам его не пробовал

Код: Выделить всё

Process1.Create(nil);
Process1.CommandLine:='qqq.exe';
Process1.Options := Process1.Options + [poWaitOnExit, poUsePipes];
Process1.Execute;
Memo1.Lines.LoadFromStream(Process1.Output);
Process1.Free;


[shade]

или второй вопрос, как получить вывод другой программы ?

Если найдешь приемлемое решение этой, поделись - мне тоже нужно.

Memo1.Lines.LoadFromStream(Process1.Output);

Я что-то подобное пробовал - под Windows не работает.

Вот модифицированный вариант под Windows с использованием WinAPI

Код: Выделить всё

{$MODE OBJFPC}{$H+}

uses windows, pipes, process;

function ReadStr(Stream: TInputPipeStream): AnsiString;
begin
  SetLength(Result, Stream.NumBytesAvailable);
  Stream.Read(Result[1], Length(Result));
end;

var
  p: TProcess;
  s: ansistring;
  h: array [0..1] of THandle;
begin
  p := TProcess.Create(nil);
  Assert(p <> nil);
  p.Options := [poUsePipes];
  p.CommandLine := 'svn status --verbose ' + ParamStr(1);
  p.Execute;
  h[0] := p.ProcessHandle;
  h[1] := p.Output.Handle;
  S := '';
  while p.Running do
  begin
    WaitForMultipleObjects(2, @h, false, INFINITE);
    s := s + ReadStr(p.Output);
  end; // while
  writeln('Len: ', Length(S));
  writeln('"', S, '"');
end.

Linux-вариант предложили на lindevel.ru: http://forum.lindevel.ru/viewtopic.php?t=335

Код: Выделить всё

#include <stdio.h>
#include <unistd.h>

int main (void)
{
        int pds[2];
        char ch;

        if (!fork()) {
                pipe (pds);
                dup2 (1, pds[1]);
                sleep (2);
                execlp ("ls", "ls", "/", NULL);
        }

        while (read (pds[0], &ch, 1) > 0)
                write (1, &ch, 1);

        wait (NULL);
        return 0;
}

Здесь наверное есть подводный камень: "что если файловый дескриптор pipe не будет закрыт?"
Но пока небыло времени проверить и превести оба варианта к общему знаменателю, т.к. к кроссплатформеному решению.

[Cheb]

Я что-то подобное пробовал - под Windows не работает.

В FPC 2.0.4 TProcess сломан. Не работают даже простейшие примеры с их собственного сайта. В Виндовс получается какой-то livelock: запущенный процесс будет считаться выполняющимся, пока его не снимешь через диспетчер задач. Только после этого ваша программа получает весь его вывод из Output.
В Линукс Output просто всегда пуст, а вывод процесса программы уходит в неизвестно куда.

[Attid]

толи я дурак толи лыжы не едут, вчера тут написал целую кучу а сегодня моего сообщения нету =/

было примерно следущее
по первому варианту работает, но не всегда =(

Код: Выделить всё

uses  process;
****
  with TProcess.Create(nil) do
  try
    CommandLine:=Edit1.Text;
    Options := Options + [poWaitOnExit, poUsePipes];
    Execute;
    Memo1.Lines.LoadFromStream(Output);
  finally
    Free;
  end;


например /opt/firebird/bin/isql --help не работает =(

по второму переделал так , не работает =/
что не так ?

Код: Выделить всё

uses baseunix;
*****
var
  pid :longint;
  pds :TFilDes;
  ch : Char;
begin
  pid:=fpFork;
  if pid=0 then
   begin
      if FpPipe(pds) = -1 then
      begin
        ShowMessage('error calling pipe');
        halt(1);
      end;
      FpDup2(1, pds[1]);
      FpSleep (2);
      FpExecv('/bin/ls',nil);
      ShowMessage('Error exec');
   end
  else
   if pid=-1 then
    begin
      ShowMessage('Error fork');
    end;

  while fpread(pds[0], ch, sizeof(ch)) > 0 do
    Memo1.Lines.Text := Memo1.Lines.Text + ch;

  FpWait(pid);   
end;


[Cheb]

См. мой пост выше. TProcess сломан. Ну не работает в нём перенаправление ввода-вывода, хоть ты ап стенку убейся.
Баг такой.

[shade]

Под Windows есть два способа вывести текст на консоль:
1. используя stdout
2. используя WriteConsole
Если прога использует второй вариант, то как не переопределяй вывод, ничего не полушь (вроде так...)

[shade]

Вариант типа:

Код: Выделить всё

uses  process;
****
  with TProcess.Create(nil) do
  try
    CommandLine:=Edit1.Text;
    Options := Options + [poWaitOnExit, poUsePipes];
    Execute;
    Memo1.Lines.LoadFromStream(Output);
  finally
    Free;
  end;

Не будет работать с большим выводом, т.к. буфер pipe ограничен, по умолчанию кажется 4Кб, подому будет deedlock - вызываемая программа будет ждать пока буфер освободиться, а взывающая ждет пока завершиться вызываемая....

Поэтому см. вариант с WaitForMultipleObjects...
Вот обновленный пример для сравнения с использованием stdout и WriteConsole:
http://the1st.adygnet.ru/~ftp/pub/examp ... stdout.zip

Для Linux сейчас перезагружусь и буду тестить...

[shade]

Не много помучавшись под linux тоже заработало (почему-то не сработал для /bin/ls - а может просто в текущей папке было пусто...)

Что-то наш сервер не доступен
Качайте тут http://zolotov.h14.ru/download/dl.php?f=stdout.zip (тут и windows и linux)

На lindevel.ru смутили - пайпы нужно открывать до форка, а то папы будут только у одного из процессов, а у другого будет мусор...

[Attid]

shade
увидел у тебя в коде не используемую мною процедуру Assert
несовсем понял назначение это типа
if a=b then halt(333)

PS stdout.zip надо теперь в компонентик преоброзовать =)
Добавленно: уже почти готов, буду в новый svn пробиваться.
Еще добавленно: добрлся до svn а там уже класс есть =(

[shade]

Assert в некоторых случаях лучше чем if a=b then halt(333)

1. генерируется исключение которое можно обработать в try/except/finally, так что если на то пошло то лучше заменять на if a=b then raise Exception.Create('blablabla');
2. Assert можно включать и отключать с помощью директивы {$ASSERTIONS ON} - если отключаешь, то код проверки не генерируется, следовательно работает быстрее (но я обычно не отключаю даже в релизах). С отключениями нужно быть осторожнее: если сделать так
Assert(db_open('test')), то если ассерты отключть, то не будет производиться вызов db_open('test')... лучше так
...
f = db_open('test');
assert(f);
...

Вообще я очень люблю эту функцию, как и raise/try/except/finally...

[Attid]

shade
у тя svn версии лазаря\фпц ??

а то у меня нет
Stream.NumBytesAvailable;
=)

[shade]

у тя svn версии лазаря\фпц ??

Да

[Attid]

shade
счастья нет =(
в венде из-за отсутствия

Код: Выделить всё

Stream.NumBytesAvailable;

ничего не работает, но я там даже не смотрел не так критично.

а вот под линухом

Код: Выделить всё

   fpExecv('/opt/firebird/bin/isql', StringToPPChar(pchar('-help'),1));

хоть убей не возрощает ничего через pipe =(
есть еще мысли ?

я понял он неправельный даже

Код: Выделить всё

$ /opt/firebird/bin/isql -help | grep SQL

не работает =)

так что в пример по лину просто добавь пример параметра и пишем его рабочим

[shade]

счастья нет =(
в венде из-за отсутствия Stream.NumBytesAvailable; ничего не работает, но я там даже не смотрел не так критично.

Счастье есть, Stream.NumBytesAvailable не нужен, исправил test.pas

а вот под линухом
fpExecv('/opt/firebird/bin/isql', StringToPPChar(pchar('-help'),1));
хоть убей не возрощает ничего через pipe =(
есть еще мысли ?

у меня почему-то /bin/ls не срабатывал?..
Мыслей пока нет, да и надежд на то что они скоро появятся нет, у мя только WinAPI опыт..
нужно грызть man pipe или что-то вроде этого.
А

Код: Выделить всё

/opt/firebird/bin/isql -help > x.txt

работает? может хелп выводиться не известно по каким причинам в stderr

так что в пример по лину просто добавь пример параметра и пишем его рабочим

Не понял какого параметра?

PS: Пора бы тему порезать