cmd realtime и pipe

[firstoxe]

Привет всем, кто может подсказать по коду:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
procedure RunDosInMemo(DosApp: String; AMemo: TMemo);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure tform1.RunDosInMemo(DosApp: String; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PAnsichar;
  BytesRead: DWord;
  Apprunning: DWord;
  Fil: string;
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_SHOW;
    Fil := DosApp;
    //Fil := Fil + dd;
    if CreateProcess(pointer(fil), pchar(fil+' /c ping mail.ru && exit'), @Security, @Security, true,
      NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject
          (ProcessInfo.hProcess, 100);
        ReadFile(ReadPipe, Buffer[0],
          ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        AMemo.Text := AMemo.text + string(Buffer);

        Application.ProcessMessages;

      until (Apprunning <> WAIT_TIMEOUT);
      Repeat
        BytesRead := 0;
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        AMemo.Text := AMemo.Text + String(Buffer);
      until (BytesRead < ReadBuffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  RunDosInMemo('c:\windows\system32\cmd.exe', Memo1);
end;

end.

Долго копался в сети, нашел примеры, проблемы и их решения (но не всех). Пишу на Rad studio xe8.
Проблема: после нажатия на кнопку, запускается cmd с командой ping на сайт, всё отлично вырисовывается, но после завершения работы cmd прога намертво виснит на этом участке кода:

        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);

при за пуске с ключами /c и доп командой exit (она не спасает ситуацию)
если только с одним ключом /c без exit то, консоль закрывается и прога виснит

при запуске с ключом /k выдает такое после 4 пинга

Обмен пакетами с mail.ru [217.69.139.200] с 32 байтами данных:
Ответ от 217.69.139.200: число байт=32 время=2мс TTL=56
Ответ от 217.69.139.200: число байт=32 время=2мс TTL=56
Ответ от 217.69.139.200: число байт=32 время=1мс TTL=56
Ответ от 217.69.139.200:
C:\Users\1\Documents\Embarcadero\St udio\Projects\Win32\Debug>
C:\Users\1\Documents\Embarcadero\St udio\Projects\Win32\Debug>C:\User
и то что это не является внутренней или внешней программой или файлом

[firstoxe]

копался у буржуев и нашёл вот этот код:

 function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  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_Show;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            OemToAnsi(Buffer, (Buffer));
            Result := Result + Buffer;
            form1.memo1.text:=form1.memo1.text + string(Buffer);
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

чутка поправил под себя, работает замечательно, но как сделать его реал тайм? Не могу совместить эти 2 кода

[firstoxe]

нашёл решение у буржуев, больше не актуально