Как вывести результат работы консоли в Memo?

Материал из DRKB

Как вывести результат работы консоли в Memo?[править | править код]

Код взят из http://www.torry.net/memos.htm

procedure Dos2Win(CmdLine: string; OutMemo: TMemo);
const
  BUFSIZE = 2000;
var
  SecAttr: TSecurityAttributes;
  hReadPipe, hWritePipe: THandle;
  StartupInfo: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PChar;
  WaitReason, BytesRead: DWord;
begin
  with SecAttr do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := True;
    lpsecuritydescriptor := nil;
  end;
  // Creazione della pipe
  if CreatePipe(hReadPipe, hWritePipe, @SecAttr, 0) then
  begin
    Buffer  := AllocMem(BUFSIZE + 1);    // Allochiamo un buffer di dimensioni BUFSIZE+1
    FillChar(StartupInfo, Sizeof(StartupInfo), #0);
    StartupInfo.cb          := SizeOf(StartupInfo);
    StartupInfo.hStdOutput  := hWritePipe;
    StartupInfo.hStdInput   := hReadPipe;
    StartupInfo.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := SW_HIDE;

    if CreateProcess(nil, PChar(CmdLine), @SecAttr, @SecAttr, True,
      NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
    begin
      // Attendiamo la fine dell'esecuzione del processo
      repeat
        WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100);
        Application.ProcessMessages;
      until (WaitReason <> WAIT_TIMEOUT);
      // Leggiamo la pipe
      repeat
        BytesRead := 0;
        // Leggiamo "BUFSIZE" bytes dalla pipe
        ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);
        // Convertiamo in una stringa "\0 terminated"
        Buffer[BytesRead]:= #0;
        // Convertiamo i caratteri da DOS ad ANSI
        OemToAnsi(Buffer,Buffer);
        // Scriviamo nell' "OutMemo" l'output ricevuto tramite pipe
        OutMemo.Text := OutMemo.text + String(Buffer);
      until (BytesRead < BUFSIZE);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(hReadPipe);
    CloseHandle(hWritePipe);
  end;
end;


Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02099



А это исправленный Song'ом вариант для обеспечения вывода текста в real-time:

procedure RunDosInMemo(CmdLine: string; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  Start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: Pchar;
  BytesRead: DWord;
  AppRunning: DWord;
begin
  Screen.Cursor := CrHourGlass;
  Form1.Button1.Enabled := False;
  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(CmdLine), @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);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
  Screen.Cursor := CrDefault;
  Form1.Button1.Enabled := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  RunDosInMemo('ping -t 192.168.28.200', Memo1);
end;


Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02100



Это пример запуска консольных программ с передачей ей консольного ввода (как если бы он был введен с клавиатуры после запуска программы) и чтением консольного вывода. Таким способом можно запускать например стандартный виндовый ftp.exe (в невидимом окне) и тем самым отказаться от использования специализированных, зачастую глючных компонент.

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 BytesRead <> 1024 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 i <> WAIT_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.hProcess <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(ProcInf.hThread);
    i := WaitForSingleObject(ProcInf.hProcess, 1000);
    CloseHandle(ProcInf.hProcess);
    if i <> WAIT_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;



Source: Взято из http://forum.sources.ru
ID: 02101