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

=== Как вывести результат работы консоли в 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