Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 Запустить с Delphi консольное приложение и считать его вывод  [new]
Zmiy
Member

Откуда:
Сообщений: 1401
Добрый день.

Столкнулся с непонятной проблемой. Из дельфи вызываю консольное приложение и считываю его вывод. Проблема в том, что в компилированной версии работает не стабильно, случается что программа просто зависает и дальше не идет. Если запускаю напрямую из дельфи, то при работе консольной программы выходит сообщение отладчика в асемблере и после последующего нажати Run все продолжается как и должно.

С консоли читаю так:
+
class function TIDCard.readData(DosApp: string): string;
const
  ReadBuffer = 2400;
var
  Security : TSecurityAttributes;
  ReadPipe,WritePipe : THandle;
  start : TStartUpInfo;
  ProcessInfo : TProcessInformation;
  Buffer : Pchar;
  BytesRead : DWord;
  Apprunning : DWord;
begin
  with Security do begin
   nlength := SizeOf(TSecurityAttributes) ;
   binherithandle := true;
   lpsecuritydescriptor := nil;
  end;
  if Createpipe (ReadPipe, WritePipe, @Security, 0) then begin
    Buffer := AllocMem(ReadBuffer + 1) ;
    FillChar(Start,Sizeof(Start),#0) ;
    start.cb := SizeOf(start) ;
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES +  STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if CreateProcess(nil,                            //Тут окно с ассемблером
              PChar(DosApp),
              @Security,
              @Security,
              true,
              NORMAL_PRIORITY_CLASS,
              nil,
              nil,
              start,
              ProcessInfo)
    then begin
      repeat
       Apprunning := WaitForSingleObject
                    (ProcessInfo.hProcess,100) ;
       Application.ProcessMessages;
      until (Apprunning <> WAIT_TIMEOUT) ;
      Repeat
         BytesRead := 0;
         ReadFile(ReadPipe,Buffer[0],
         ReadBuffer,BytesRead,nil) ;
         Buffer[BytesRead]:= #0;
         OemToAnsi(Buffer,Buffer) ;
         Result := Result + String(Buffer) ;
      until (BytesRead < ReadBuffer) ;
    end;
    FreeMem(Buffer) ;
    CloseHandle(ProcessInfo.hProcess) ;
    CloseHandle(ProcessInfo.hThread) ;
    CloseHandle(ReadPipe) ;
    CloseHandle(WritePipe) ;
  end;
end;

В коде вызываю метод таким образом:
            Application.ProcessMessages;
            Self.loggedIdCode := TIDCard.getPersonalCode;
            Application.ProcessMessages;


Так же впомогательный методы:
class function TIDCard.getPersonalCode: string;
begin
  Result := getValue('Personal ID code');
end;

class function TIDCard.getValue(name: string): string;
var
  src: string;
  startIdx: integer;
begin
  src := readData('idcard/eidenv.exe');
  startIdx := Pos(name, src);
  if (startIdx > 0) then begin
    Result := Copy(src, startIdx + length(name) + 2, 11);
  end else begin
    Result := '';
  end;
end;


Может кто-нибудь подскажет в какую сторону копать?

Заранее благодарен.

К сообщению приложен файл. Размер - 70Kb
14 окт 11, 17:20    [11443011]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
demian111
Member

Откуда:
Сообщений: 6241
Zmiy
случается что программа просто зависает и дальше не идет

как минимум два места вижу:
1. консольная прога не умирает, и ты в вечном цикле с вечной Application.ProcessMessages.
2. цикл чтения из пайпы, если начитывается не меньше чем размер буфера, то повторное чтение, а там уже нету байтов и висим ...
OemToAnsi - Obsolete.

з.ы.
ну и я бы в потоке начитывал.
14 окт 11, 18:07    [11443316]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
bk0010
Member

Откуда:
Сообщений: 4662
Пример из DelphiWorld:
+
function ExecuteFile(FileName, StdInput: string;
  TimeOut: integer;
  var StdOutput: string): boolean;

label
  Error;

type
  TPipeHandles = (IN_WRITE, IN_READ,
    OUT_WRITE, OUT_READ,
    ERR_WRITE, ERR_READ);

type
  TPipeArray = array[TPipeHandles] of THandle;

var
  i: integer;
  ph: TPipeHandles;
  sa: TSecurityAttributes;
  Pipes: TPipeArray;
  StartInf: TStartupInfo;
  ProcInf: TProcessInformation;
  Buf: array[0..1024] of byte;
  TimeStart: TDateTime;

  function ReadOutput: string;
  var
    i: integer;
    s: string;
    BytesRead: longint;

  begin
    Result := '';
    repeat

      Buf[0] := 26;
      WriteFile(Pipes[OUT_WRITE], Buf, 1, BytesRead, nil);
      if ReadFile(Pipes[OUT_READ], Buf, 1024, BytesRead, nil) then
      begin
        if BytesRead > 0 then
        begin
          buf[BytesRead] := 0;
          s := StrPas(@Buf[0]);
          i := Pos(#26, s);
          if i > 0 then
            s := copy(s, 1, i - 1);
          Result := Result + s;
        end;
      end;

      if BytesRead1024 then
        break;
    until false;
  end;

begin
  Result := false;
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    Pipes[ph] := INVALID_HANDLE_VALUE;

  // Создаем пайпы
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := TRUE;
  sa.lpSecurityDescriptor := nil;

  if not CreatePipe(Pipes[IN_READ], Pipes[IN_WRITE], @sa, 0) then
    goto Error;
  if not CreatePipe(Pipes[OUT_READ], Pipes[OUT_WRITE], @sa, 0) then
    goto Error;
  if not CreatePipe(Pipes[ERR_READ], Pipes[ERR_WRITE], @sa, 0) then
    goto Error;

  // Пишем StdIn
  StrPCopy(@Buf[0], stdInput + ^Z);
  WriteFile(Pipes[IN_WRITE], Buf, Length(stdInput), i, nil);

  // Хендл записи в StdIn надо закрыть - иначе выполняемая программа
  // может не прочитать или прочитать не весь StdIn.

  CloseHandle(Pipes[IN_WRITE]);

  Pipes[IN_WRITE] := INVALID_HANDLE_VALUE;

  FillChar(StartInf, sizeof(TStartupInfo), 0);
  StartInf.cb := sizeof(TStartupInfo);
  StartInf.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  StartInf.wShowWindow := SW_SHOW; // SW_HIDE если надо запустить невидимо

  StartInf.hStdInput := Pipes[IN_READ];
  StartInf.hStdOutput := Pipes[OUT_WRITE];
  StartInf.hStdError := Pipes[ERR_WRITE];

  if not CreateProcess(nil, PChar(FileName), nil,
    nil, True, NORMAL_PRIORITY_CLASS,
    nil, nil, StartInf, ProcInf) then
    goto Error;

  TimeStart := Now;

  repeat
    Application.ProcessMessages;
    i := WaitForSingleObject(ProcInf.hProcess, 100);
    if i = WAIT_OBJECT_0 then
      break;
    if (Now - TimeStart) * SecsPerDay > TimeOut then
      break;
  until false;

  if iWAIT_OBJECT_0 then
    goto Error;
  StdOutput := ReadOutput;

  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    if Pipes[ph]INVALID_HANDLE_VALUE then
      CloseHandle(Pipes[ph]);

  CloseHandle(ProcInf.hProcess);
  CloseHandle(ProcInf.hThread);
  Result := true;
  Exit;

  Error:

  if ProcInf.hProcessINVALID_HANDLE_VALUE then

  begin
    CloseHandle(ProcInf.hThread);
    i := WaitForSingleObject(ProcInf.hProcess, 1000);
    CloseHandle(ProcInf.hProcess);
    if iWAIT_OBJECT_0 then

    begin
      ProcInf.hProcess := OpenProcess(PROCESS_TERMINATE,
        FALSE,
        ProcInf.dwProcessId);

      if ProcInf.hProcess 0 then
      begin
        TerminateProcess(ProcInf.hProcess, 0);
        CloseHandle(ProcInf.hProcess);
      end;
    end;
  end;

  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    if Pipes[ph]INVALID_HANDLE_VALUE then
      CloseHandle(Pipes[ph]);
end;
14 окт 11, 22:56    [11444590]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Zmiy
Member

Откуда:
Сообщений: 1401
demian111,

То есть ее надо самому убивать?
17 окт 11, 11:07    [11449750]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Zmiy
Member

Откуда:
Сообщений: 1401
bk0010,

В 7й версии дельфи не билдится. Говорит
Types of actual and formal var parameters must be identical

В строке:
WriteFile(Pipes[OUT_WRITE], Buf, 1, BytesRead, nil);
17 окт 11, 11:28    [11449847]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Anatoly Podgoretsky
Member

Откуда:
Сообщений: 62926
Разве nil var параметр?
17 окт 11, 11:39    [11449923]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Zmiy
Member

Откуда:
Сообщений: 1401
В статье по крайней мере такой код. Кажется он не для 7й версии.
17 окт 11, 12:41    [11450544]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Alex Kuznetsov
Member

Откуда: Ростов-на-Дону
Сообщений: 1789
Zmiy,

если вызов консольного приложения не требует интерактивной с ней работы, а просто консольная программа что-то выполняет на основании параметров, то я-бы перенаправил её вывод в файл и после завершения считывал-бы весь файл.

Как Вам такой вариантец?
17 окт 11, 14:15    [11451573]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Zmiy
Member

Откуда:
Сообщений: 1401
Можно и в файл, но тогда встает вопрос как определить что запись в файл прошла успешно?
17 окт 11, 14:27    [11451689]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
чччД
Guest
Zmiy,

Ну, раз есть возможность выбора вариантов взаимодействия - это ж супер!
:)
Можно задействовать различные варианты ipc, начиная с обмена сообщениями и dde. А если объем данных велик - можно в к-н субд писать. Вопросы синхронизации в последнем случае решаются автоматически, механизмом транзакций.
17 окт 11, 15:04    [11452077]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
чччД
Guest
Zmiy
Можно и в файл, но тогда встает вопрос как определить что запись в файл прошла успешно?

Методом попытки открытия файла в режиме эксклюзивного доступа.
17 окт 11, 15:06    [11452111]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
bk0010
Member

Откуда:
Сообщений: 4662
Zmiy
bk0010,

В 7й версии дельфи не билдится. Говорит
Types of actual and formal var parameters must be identical

В строке:
WriteFile(Pipes[OUT_WRITE], Buf, 1, BytesRead, nil);

Заведите переменную типа POverlapped, присвойте ей nil и замените nil в функции на нее
17 окт 11, 22:51    [11455694]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Alex Kuznetsov
Member

Откуда: Ростов-на-Дону
Сообщений: 1789
Zmiy
Можно и в файл, но тогда встает вопрос как определить что запись в файл прошла успешно?

Zmiy, запись в файл пройдёт успешно, не переживайте, потому что не Вы будете писать в файл, а система. Т.е. вывод будет перенаправлен с консоли в файл. Вам-же нужно просто дождаться завершения исполнения консольного приложения и считать полученный файл. Надеюсь Вы знаете КАК нужно написать строку исполнения, чтобы вывод пошёл в файл ;-)
18 окт 11, 06:12    [11456416]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Човайохоя
Guest
А можно ли получить вывод из программы с псевдографическим интерфейсом, таких как FAR Manager ?
18 окт 11, 12:38    [11458312]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Човайохоя
Guest
Човайохоя
А можно ли получить вывод из программы с псевдографическим интерфейсом, таких как FAR Manager ?
Если просто перенаправить вывод в файл, то файл создается пустой
18 окт 11, 12:52    [11458488]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Zmiy
Member

Откуда:
Сообщений: 1401
Спасибо всем, в итоге заработал такой вариант:
+
class procedure TIDCard.CaptureConsoleOutput(DosApp : string; cpt : TCaption);
const
  ReadBuffer = 1048576;  // 1 MB Buffer
var
  Security            : TSecurityAttributes;
  ReadPipe,WritePipe  : THandle;
  start               : TStartUpInfo;
  ProcessInfo         : TProcessInformation;
  Buffer              : Pchar;
  TotalBytesRead,
  BytesRead           : DWORD;
  Apprunning,n,
  BytesLeftThisMessage,
  TotalBytesAvail : integer;
begin
  with Security do
  begin
    nlength              := SizeOf(TSecurityAttributes);
    binherithandle       := true;
    lpsecuritydescriptor := nil;
  end;

  if CreatePipe (ReadPipe, WritePipe, @Security, 0) then
  begin
    // Redirect In- and Output through STARTUPINFO structure

    Buffer  := AllocMem(ReadBuffer + 1);
    FillChar(Start,Sizeof(Start),#0);
    start.cb          := SizeOf(start);
    start.hStdOutput  := WritePipe;
    start.hStdInput   := ReadPipe;
    start.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;

    // Create a Console Child Process with redirected input and output

    if CreateProcess(nil      ,PChar(DosApp),
                     @Security,@Security,
                     true     ,CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
                     nil      ,nil,
                     start    ,ProcessInfo) then
    begin
      n:=0;
      TotalBytesRead:=0;
      repeat
        // Increase counter to prevent an endless loop if the process is dead
        Inc(n,1);
        
        // wait for end of child process
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
        Application.ProcessMessages;

        // it is important to read from time to time the output information
        // so that the pipe is not blocked by an overflow. New information
        // can be written from the console app to the pipe only if there is
        // enough buffer space.

        if not PeekNamedPipe(ReadPipe        ,@Buffer[TotalBytesRead],
                             ReadBuffer      ,@BytesRead,
                             @TotalBytesAvail,@BytesLeftThisMessage) then break
        else if BytesRead > 0 then
          ReadFile(ReadPipe,Buffer[TotalBytesRead],BytesRead,BytesRead,nil);
        TotalBytesRead:=TotalBytesRead+BytesRead;
      until (Apprunning <> WAIT_TIMEOUT) or (n > 150);

      Buffer[TotalBytesRead]:= #0;
      OemToChar(Buffer,Buffer);
      cpt := cpt + StrPas(Buffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;
18 окт 11, 13:53    [11459122]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
dima70
Member

Откуда: г. Пушкино м.о.
Сообщений: 1
function CaptureConsoleOutput(DosApp : string):AnsiString;
const
  ReadBuffer = 1048576;  // 1 MB Buffer
var
  Security            : TSecurityAttributes;
  ReadPipe,WritePipe  : THandle;
  start               : TStartUpInfo;
  ProcessInfo         : TProcessInformation;
  Buffer              : PAnsiChar;
  TotalBytesRead,
  BytesRead           : DWORD;
  Apprunning,n,
  BytesLeftThisMessage,
  TotalBytesAvail : integer;
begin
  with Security do
  begin
    nlength              := SizeOf(TSecurityAttributes);
    binherithandle       := true;
    lpsecuritydescriptor := nil;
  end;

  if CreatePipe (ReadPipe, WritePipe, @Security, 0) then
  begin
    // Redirect In- and Output through STARTUPINFO structure

    Buffer  := AllocMem(ReadBuffer + 1);
    FillChar(Start,Sizeof(Start),#0);
    start.cb          := SizeOf(start);
    start.hStdOutput  := WritePipe;
    start.hStdInput   := ReadPipe;
    start.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;

    // Create a Console Child Process with redirected input and output

    if CreateProcess(nil      ,PChar(DosApp),
                     @Security,@Security,
                     true     ,CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
                     nil      ,nil,
                     start    ,ProcessInfo) then
    begin
      n:=0;
      TotalBytesRead:=0;
      repeat
        // Increase counter to prevent an endless loop if the process is dead
        Inc(n,1);

        // wait for end of child process
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
        Application.ProcessMessages;

        // it is important to read from time to time the output information
        // so that the pipe is not blocked by an overflow. New information
        // can be written from the console app to the pipe only if there is
        // enough buffer space.

        if not PeekNamedPipe(ReadPipe        ,@Buffer[TotalBytesRead],
                             ReadBuffer      ,@BytesRead,
                             @TotalBytesAvail,@BytesLeftThisMessage) then break
        else if BytesRead > 0 then
          ReadFile(ReadPipe,Buffer[TotalBytesRead],BytesRead,BytesRead,nil);
        TotalBytesRead:=TotalBytesRead+BytesRead;
      until (Apprunning <> WAIT_TIMEOUT) or (n > 150);

      Buffer[TotalBytesRead]:= #0;
     // OemToChar(Buffer,Buffer);
      Result := Result + StrPas(Buffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;


Подправит чуток для XE3...
30 дек 13, 12:10    [15364130]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
avlaxoft
Member

Откуда: г. Калуга
Сообщений: 472
dima70,

Последний пример не работает на Delphi Tokyo 10.2, валится на "if CreateProcess..."
22 сен 18, 15:08    [21682675]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 339
avlaxoft,

естественно падает. Ведь DosApp объявлен как string, т.е. в Delphi 10.2 это unicode-строка (1 символ - 2 байта).
А в строке "if CreateProcess" идет приведение DosApp к PChar (1 символ - 1 байт).

Доработайте немного код и он заработает :-)
22 сен 18, 23:01    [21682876]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 339
Хотя конечно я погорячился, не подумав. pchar это же PWideChar)))
22 сен 18, 23:05    [21682880]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 46152

asutp2
PChar (1 символ - 1 байт).

Не хочу тебя разочаровывать, но PChar там тоже юникодский, 1 символ = 2 байта. И что хуже
всего: CreateProcess должен бы использоваться в юникодной версии (АКА CreateProcessW), так
что проблема не в нём.

Posted via ActualForum NNTP Server 1.5

22 сен 18, 23:09    [21682882]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 339
Dimitry Sibiryakov,

это я понял через минуту после написания своего поста)))) прочитай пост выше своего)))
23 сен 18, 01:35    [21682911]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 46152

asutp2
это я понял через минуту после написания своего поста)))) прочитай пост выше своего)))

Да, да, видел. Я тоже не чемпион мира по скоростному набору текста.

Posted via ActualForum NNTP Server 1.5

23 сен 18, 12:25    [21683049]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
schi
Member

Откуда: Москва
Сообщений: 2601
Обработку ошибок в примерах Пушкин конечно же выполняет.
23 сен 18, 13:32    [21683071]     Ответить | Цитировать Сообщить модератору
 Re: Запустить с Delphi консольное приложение и считать его вывод  [new]
avlaxoft
Member

Откуда: г. Калуга
Сообщений: 472
Если кому ещё интересно: вот работающий пример (сорри за лишние комментарии, некогда было код причёсывать...):

+
unit uMain;

interface

uses
   Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, System.Classes, Vcl.ExtCtrls,
   Windows, StrUtils, SysUtils;

type
  //TAttachConsole = function (dwProcessId: DWORD): LongBOOL stdcall;

  TfmMain = class(TForm)
    btMyButton: TButton;
    edText: TEdit;
    btClear: TButton;
    memOut: TMemo;
    procedure btMyButtonClick(Sender: TObject);
    procedure btClearClick(Sender: TObject);
  private
    { Private declarations }
    function GetDosOutput(const CommandLine: string): string;
  public
    { Public declarations }
  end;

var
  fmMain: TfmMain;

const
  C_EXE_CMD = 'c:\Program Files\SlikSvn\bin\svn.exe log -r '; //'c:\Program Files\SlikSvn\bin\svn.exe';
  C_WORKING_DIR = 'c:\Users\ALEX\Documents\MxLib\';
  C_BUF_SIZE = 1024;
  //Вова "c:\Program Files\SlikSvn\bin\svn.exe"

implementation

{$R *.dfm}

var stopfunc: Integer;

function DosToWin(ASource: AnsiString): AnsiString;
 var
   Ch: PAnsiChar;
 begin
   Ch := AnsiStrAlloc(Length(ASource) + 1);
   OemToAnsi(PAnsiChar(ASource), Ch);
   Result := StrPas(Ch);
   StrDispose(Ch);
 end;

procedure TfmMain.btClearClick(Sender: TObject);
begin
  edText.Clear;
  memOut.Clear;
end;

function TfmMain.GetDosOutput(const CommandLine: string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfoA;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..C_BUF_SIZE - 1] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir, Line: AnsiString;
  i:Integer;
begin
//stopfunc:=0;
  Application.ProcessMessages;
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;

  CreatePipe(StdOutPipeRead,
             StdOutPipeWrite,
             @SA,
             0
             );
  try

    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE);
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;

    WorkDir := C_WORKING_DIR; //ExtractFilePath(CommandLine);

    WasOK := CreateProcessA(nil, PAnsiChar(AnsiString(CommandLine)), nil, nil, True, 0, nil, PAnsiChar(WorkDir{'C:\WINDOWS\system32\'}), SI, PI);
    //WasOK := CreateProcess(nil, PChar('C:\WINDOWS\system32\cmd.exe'), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);

    CloseHandle(StdOutPipeWrite);

    if not WasOK then
      raise Exception.Create('Could not execute command line!')
    else
      try

        Line := '';
        repeat

          WasOK := ReadFile(StdOutPipeRead, Buffer, C_BUF_SIZE, BytesRead, nil);
          if BytesRead > 0 then

          begin

            Buffer[BytesRead] := #0;
            Line := Line + Buffer;
            {if (Copy(Form1.Edit1.text,1,4) = 'ping') then
            begin
            }
             //Memo1.text := DosToWin(Line); // конвертим вывод в мемо, с ОЕМ в Анси
             //Perform(EM_LINESCROLL,0,Memo1.Lines.Count-1); // автопрокрутка мемо вниз
               //////////////////////////  пауза, чтоб не висло окно при пинге и множественных выводов консоли

              {i := 0;
               while i<100 do begin
              sleep(12);
              Application.ProcessMessages;
              inc(i);
              end;
              }
              Application.ProcessMessages;

                //// убиваем процессы
              if stopfunc = 1 then
               begin
               CloseHandle(PI.hThread);
               CloseHandle(PI.hProcess);
               //shellexecute(0,'Open',Pchar('taskkill'),'/im cmd.exe /f',0,SW_HIDE);
               //shellexecute(0,'Open',Pchar('taskkill'),'/im ping.exe /f',0,SW_HIDE);
              Exit;
             end;
            //end;


          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
      result:=Line;
      CloseHandle(StdOutPipeRead);
  end;
end;

procedure TfmMain.btMyButtonClick(Sender: TObject);
begin
  memOut.Lines.Text := GetDosOutput(C_EXE_CMD + Trim(edText.Text));
end;

end. 
2 ноя 18, 13:05    [21722460]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить