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

[shade]

О, та же тема в рассылке [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 - оставлю на всякий случай, может кому сгодиться.

[Attid]

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

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

//------------------------------------------------------------------------------
//* 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;

************************}

[noch]

я конечно не кроссплатформенное решение предлагаю, но есть функция 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 и скомпилить корректно выполняемую программу с его помощью не выйдет

[serg_iv]

Нашел в примерах, маленько переделал. Пример протестирован в Мандриве 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.

[Cheb]

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]

Интересно, а как отдать исполняемому 100% процессора? Можно как-нибудь сюда вплести Sleep() ?
И как вообще Sleep() работает в линуксе?

[Cheb]

глупость сморозил. Очевидно, оно ждёт в read()

[Cheb]

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.

[ZerstoreN]

а считать вывод WinCE процесса, запущенного с PC ?

[SovNarKom]

ZerstoreN
Приведи конкретный пример пожалуйста

[ZerstoreN]

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

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

пока склоняюсь к тому что надо будет сделать на стороне pc tcp/ip сервер и передавать в командную строку при запуске процесса порт и ip-адрес (стандартный ввод вывод естественно тогда не нужен)

[Cheb]

удл

[Sash0k]

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

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

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

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

Дорбрый день! Проясните пожалуйста, нужно ли после этого "закрывать" процесс (по аналогии с закрытием файлов)? То есть, нужна ли в конце примера процедура pclose(f)? Пишу под линукс, с лазарусом только осваиваюсь.

[Attid]

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

[Sash0k]

Attid благодарю за ответ