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

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

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

Сообщение shade » 11.05.2007 14:45:29

О, та же тема в рассылке [fpc-pascal] Question about TProcess

см. так же
http://wiki.lazarus.freepascal.org/Exec ... rge_output
https://svn.sourceforge.net/svnroot/laz ... s/process/

добавлено
Работает одинаково хорошо как под Windows, так и под Linux, сейчас добавлю к себе в svn, те старые два варианта можно считать depricated :lol: - оставлю на всякий случай, может кому сгодиться.
Аватара пользователя
shade
энтузиаст
 
Сообщения: 879
Зарегистрирован: 21.02.2006 20:15:48
Откуда: http://shamangrad.net/

Сообщение Attid » 16.05.2007 23:31:20

на сайте фпц ответили вот так (может тоже пригодится):

Код: Выделить всё
//------------------------------------------------------------------------------
//* Check if we need to run the shell to execute our command
//------------------------------------------------------------------------------
procedure _CheckIfShellRequired(var CommandLine : string; const _CommandLine : string);
begin
  if (Pos('|', _CommandLine) <> 0) or
      (Pos('<', _CommandLine) <> 0) or
        (Pos('>', _CommandLine) <> 0) or
          (Pos('>>', _CommandLine) <> 0) or
            (Pos('{', _CommandLine) <> 0) or
              (Pos('}', _CommandLine) <> 0) then

  CommandLine := 'sh -c "' + _CommandLine + '"'
else
  CommandLine := _CommandLine;

  {$ifdef DEBUG}
    Writeln(CommandLine);
  {$endif}
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//* If we don't know the size of the output, we cannot use poWaitOnExit.
//* On Linux the size of output pipe is 2 kB.
//* If the output data is more, we need to read the data.
//* This isn't possible if we are waiting, so we would get a deadlock here.
//* The Wait parameter default value is wsNoWait.
//* Use Wait = wsWait when you need to wait for a process with little output.
//*
//* A temp Memorystream is used to buffer the output.
//------------------------------------------------------------------------------
function ExecProcess(_CommandLine : string;
                    _sList      : TStringList = nil;
                    _Wait        : TWaitState = wsNoWait) : Boolean;
const
  READ_BYTES = 2048;

var
  count    : LongInt;
  BytesRead : LongInt;
  Process  : TProcess;
  Stream    : TMemoryStream;

begin
  Stream := TMemoryStream.Create();

  try
    BytesRead := 0;

    Process := TProcess.Create(nil);

    try
      _CheckIfShellRequired(Process.CommandLine, _CommandLine);

      case _Wait of
        wsWait  : Process.Options := [poWaitOnExit, poUsePipes];
        wsNoWait : Process.Options := [poUsePipes];
      end; //* case.

      //* Run the process.
      Process.Execute();

      //* Accumulate all process output.
      while Process.Running do
      begin
        //* make sure we have room
        Stream.SetSize(BytesRead + READ_BYTES);

        //* try reading it.
        count := Process.Output.Read((Stream.Memory + BytesRead)^, READ_BYTES);

        if count > 0 then
        begin
          Inc(BytesRead, count);
        end
      else
        begin
          //* no data, wait 100 ms.
          Sleep(100);
        end;
      end;

      //* read last part.
      repeat
        //* make sure we have room.
        Stream.SetSize(BytesRead + READ_BYTES);

        //* try reading it.
        count := Process.Output.Read((Stream.Memory + BytesRead)^, READ_BYTES);

        if count > 0 then
          Inc(BytesRead, count);

      until count <= 0;

      Stream.SetSize(BytesRead);

      //* Copy Stream into sList.
      if _sList <> nil then
        _sList.LoadFromStream(Stream);

    finally
      FreeAndNil(Process);
    end;

  finally
    FreeAndNil(Stream);
  end;

  Result := True;
end;

{***********************

  Example Usage:

uses
  Classes, Process;

var
  loop  : LongInt;
  sList : TStringList;

  sList := TStringList.Create();

  try
    ExecProcess('netstat -an', sList);

    for loop := 0 to sList.Count-1 do
      Writeln(sList[loop]+#13);

  finally
    FreeAndNil(sList);
  end;

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

Сообщение noch » 20.07.2007 14:14:43

я конечно не кроссплатформенное решение предлагаю, но есть функция popen в юните Unix.
Из нее затем читают как из файла

var f : textfile;
s : string;
...

popen (f, 'ls -al', 'r');

repeat
readln (f, s);
writeln (s);
until eof(f);


Однако в версии 2.0.4 не работает, а в более новых исправлено

Именно поэтому компилятором 2.0.4 невозможно использовать мою утилиту
для генту http://ept-get.sf.net так как она берет вывод с моей же epkg
А в генту компилятор все еще 2.0.4 и скомпилить корректно выполняемую программу с его помощью не выйдет
Аватара пользователя
noch
постоялец
 
Сообщения: 145
Зарегистрирован: 07.06.2005 09:45:49
Откуда: Armenia

Сообщение serg_iv » 21.07.2007 18:15:11

Нашел в примерах, маленько переделал. Пример протестирован в Мандриве 2007РР (работает!)

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

uses classes,process;

Const BufSize = 1024;

      TheProgram = 'ls -a';

Var S : TProcess;
    Buf : Array[1..BUFSIZE] of char;
    I,Count : longint;
    ss:string;

begin
  S:=TProcess.Create(Nil);
  S.Commandline:=theprogram;
  S.Options:=[poUsePipes,poNoConsole];
  S.execute;
  Repeat
    Count:=s.output.read(buf,BufSize);
      For I:=1 to count do
      ss:=ss + buf[i];
  until Count=0;
  writeln(ss);
  S.Free;
end.
serg_iv
постоялец
 
Сообщения: 276
Зарегистрирован: 15.10.2005 18:45:46
Откуда: Миасс

Сообщение Cheb » 23.07.2007 18:20:34

I believe так будет быстрее, чем по байтику хвост кошке отрезать:
Код: Выделить всё
program prrocess;
{$mode objfpc}{$H+}
uses classes,process;

Const
  TheProgram = 'ls -a';

Var
  S : TProcess;
    Buf, ss : ansistring;
    Count : longint;
begin
  S:=TProcess.Create(Nil);
  S.Commandline:=theprogram;
  S.Options:=[poUsePipes,poNoConsole];
  S.execute;
  SetLength(buf, 1000);
  Repeat
    Count:=s.output.read(buf[1], length(buf));
    ss:=ss + Copy(buf, 1, Count);
  until Count=0;
  writeln(ss);
  S.Free;
  writeln('finished Ok.');
end.

За образец - огромное спасибо! Федора 6, ФПЦ 2.04 - работает!
Надо теперь под Вражиной ИксПи проверить.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Сообщение Cheb » 23.07.2007 18:56:01

Интересно, а как отдать исполняемому 100% процессора? Можно как-нибудь сюда вплести Sleep() ?
И как вообще Sleep() работает в линуксе?
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Сообщение Cheb » 23.07.2007 18:57:39

глупость сморозил. :oops: Очевидно, оно ждёт в read()
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Сообщение Cheb » 15.08.2007 17:37:28

I believe, this one is ещё лучше:

Код: Выделить всё
{$mode delphi}
{$longstrings on}
unit un_process;

interface
uses process, math;

type

  { TExProcess }

  TExProcess = class
  protected
    p: TProcess;
    s: string;
    function _GetExitStatus(): integer;
  public
    constructor Create(commandline: string);
    procedure Execute;
    destructor Destroy;
 
    procedure OnReadLn(s: string); virtual;
    property ExitStatus: integer read _GetExitStatus;
  end;

implementation

const buf_len = 3000;


{ TExProcess }

function TExProcess._GetExitStatus(): integer;
begin
  Result:=p.ExitStatus;
end;

constructor TExProcess.Create(commandline: string);
begin
  s:='';
  p:=TProcess.Create(nil);
  p.CommandLine:=commandline;
  p.Options:=[poUsePipes,poNoConsole];
end;

procedure TExProcess.Execute;
var
  buf: string;
  i, j, c, n: integer;
begin
  p.Execute;
  repeat
    SetLength(buf, buf_len);
    SetLength(buf, p.output.Read(buf[1], length(buf))); //waits for the process output
    // cut the incoming stream to lines:
    s:=s + buf; //add to the accumulator
    repeat //detect the line breaks and cut.
      i:=Pos(#13, s);
      j:=Pos(#10, s);
      if i=0 then i:=j;
      if j=0 then j:=i;
      if j = 0 then Break; //there are no complete lines yet.
      OnReadLn(Copy(s, 1, min(i, j) - 1)); //return the line without the CR/LF characters
      s:=Copy(s, max(i, j) + 1, length(s) - max(i, j)); //remove the line from accumulator
    until false;
  until buf = '';
  if s <> '' then OnReadLn(s);
end;

destructor TExProcess.Destroy;
begin
  p.Free;
end;

procedure TExProcess.OnReadLn(s: string);
begin
  // Do nothing ^_^
  // To be overridden.
end;

end.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Сообщение ZerstoreN » 16.08.2007 23:45:41

а считать вывод WinCE процесса, запущенного с PC ?
ZerstoreN
новенький
 
Сообщения: 53
Зарегистрирован: 30.06.2006 12:05:01

Сообщение SovNarKom » 17.08.2007 00:42:19

ZerstoreN
Приведи конкретный пример пожалуйста
SovNarKom
постоялец
 
Сообщения: 389
Зарегистрирован: 28.05.2005 10:37:39
Откуда: Воронеж [vrn] [36]

Сообщение ZerstoreN » 17.08.2007 20:43:40

процесс запускается с помощью ф-ции rapi
CeCreateProcess.
дальше нужен обмен с его вводом-выводом

процесс- своё приложение, можно модифицировать.

пока склоняюсь к тому что надо будет сделать на стороне pc tcp/ip сервер и передавать в командную строку при запуске процесса порт и ip-адрес (стандартный ввод вывод естественно тогда не нужен)
ZerstoreN
новенький
 
Сообщения: 53
Зарегистрирован: 30.06.2006 12:05:01

Сообщение Cheb » 28.01.2008 09:55:55

удл
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Re:

Сообщение Sash0k » 19.02.2009 15:14:08

noch писал(а):я конечно не кроссплатформенное решение предлагаю, но есть функция popen в юните Unix.
Из нее затем читают как из файла

var f : textfile;
s : string;
...

popen (f, 'ls -al', 'r');

repeat
readln (f, s);
writeln (s);
until eof(f);


Дорбрый день! Проясните пожалуйста, нужно ли после этого "закрывать" процесс (по аналогии с закрытием файлов)? То есть, нужна ли в конце примера процедура pclose(f)? Пишу под линукс, с лазарусом только осваиваюсь.
Последний раз редактировалось Sash0k 19.02.2009 21:30:59, всего редактировалось 1 раз.
Sash0k
новенький
 
Сообщения: 43
Зарегистрирован: 19.01.2009 11:39:27
Откуда: Вятка - Киров

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

Сообщение Attid » 19.02.2009 19:26:34

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

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

Сообщение Sash0k » 19.02.2009 21:32:51

Attid благодарю за ответ :)
Sash0k
новенький
 
Сообщения: 43
Зарегистрирован: 19.01.2009 11:39:27
Откуда: Вятка - Киров

Пред.След.

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

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

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

Рейтинг@Mail.ru