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

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

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

Сообщение Attid » 22.04.2007 22:20:51

как получить вывод другой программы ?
можно запустить с перевыводом в файл, и его отпарсить, но должно быть что-то проще =)
Последний раз редактировалось Attid 11.05.2007 17:29:27, всего редактировалось 1 раз.
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2583
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение ev » 23.04.2007 01:03:34

вот наткнулся на примерчик где-то (в инете или еще где - не помню уже), но сам его не пробовал
Код: Выделить всё
Process1.Create(nil);
Process1.CommandLine:='qqq.exe';
Process1.Options := Process1.Options + [poWaitOnExit, poUsePipes];
Process1.Execute;
Memo1.Lines.LoadFromStream(Process1.Output);
Process1.Free;
ev
долгожитель
 
Сообщения: 1717
Зарегистрирован: 27.04.2005 23:19:06
Откуда: Москва

Сообщение shade » 23.04.2007 11:25:31

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

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

ev писал(а):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 не будет закрыт?"
Но пока небыло времени проверить и превести оба варианта к общему знаменателю, т.к. к кроссплатформеному решению.
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение Cheb » 05.05.2007 14:36:10

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

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

Сообщение Attid » 05.05.2007 14:41:05

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

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

Код: Выделить всё
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;
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2583
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение Cheb » 05.05.2007 19:27:48

См. мой пост выше. TProcess сломан. Ну не работает в нём перенаправление ввода-вывода, хоть ты ап стенку убейся.
Баг такой.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 749
Зарегистрирован: 06.06.2005 15:54:34

Сообщение shade » 05.05.2007 23:31:27

Под Windows есть два способа вывести текст на консоль:
1. используя stdout
2. используя WriteConsole
Если прога использует второй вариант, то как не переопределяй вывод, ничего не полушь (вроде так...)
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение shade » 05.05.2007 23:53:32

Вариант типа:
Код: Выделить всё
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
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение shade » 06.05.2007 00:50:31

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

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

На lindevel.ru смутили - пайпы нужно открывать до форка, а то папы будут только у одного из процессов, а у другого будет мусор...
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение Attid » 07.05.2007 11:50:55

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

PS stdout.zip надо теперь в компонентик преоброзовать =)
Добавленно: уже почти готов, буду в новый svn пробиваться.
Еще добавленно: добрлся до svn а там уже класс есть =(
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2583
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение shade » 07.05.2007 12:56:11

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...
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение Attid » 09.05.2007 11:10:09

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

а то у меня нет
Stream.NumBytesAvailable;
=)
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2583
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение shade » 09.05.2007 11:59:17

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

Да
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение Attid » 10.05.2007 21:39:02

shade
счастья нет =(
в венде из-за отсутствия
Код: Выделить всё
Stream.NumBytesAvailable;

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

а вот под линухом
Код: Выделить всё
   fpExecv('/opt/firebird/bin/isql', StringToPPChar(pchar('-help'),1));


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

я понял он неправельный даже
Код: Выделить всё
$ /opt/firebird/bin/isql -help | grep SQL

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

так что в пример по лину просто добавь пример параметра и пишем его рабочим
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2583
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение shade » 11.05.2007 13:19:22

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

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

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

у меня почему-то /bin/ls не срабатывал?..
Мыслей пока нет, да и надежд на то что они скоро появятся нет, у мя только WinAPI опыт..
нужно грызть man pipe или что-то вроде этого.
А
Код: Выделить всё
/opt/firebird/bin/isql -help > x.txt
работает? может хелп выводиться не известно по каким причинам в stderr

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

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

PS: Пора бы тему порезать :roll:
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

След.

Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1

Рейтинг@Mail.ru