如何“实时”获得控制台的输出？ ( 积分: 300 )

program a3;
{$APPTYPE CONSOLE}
uses
SysUtils,
windows;

var
i:Integer;
begin
i:=0;
while i<10 do
begin
Writeln('AAAAAAA');
sleep(500);
Inc(i);
end;
end.
写一个很单的控制台代码，但是只有等到程序运行结束了。才能输入结果，而不是每隔
500毫秒就输出一行。如何解决这个问题？
网上找了很多的代码，都是只能对ping 等标准命令及程序进行实时输出，对于上面Delphi写的简单的代码都不管用。

用管道进行通信。
下面的我做的一个例子,程序会调用cmd.exe。
你可以在程序界面里进行输入，并取得cmd.exe的输出。
－－－－－－－－－－－－－－－－－－－－
unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ShellCtrls;
const
ReadBuffer = 255;
MyCommend=('CLS');
type
TForm1 = class(TForm)
Memo1: TMemo;
Timer1: TTimer;
Panel1: TPanel;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
procedure ComboBox1Select(Sender: TObject);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
private
procedure WriteToPipe(Pipe: THandle; Value: string); overload;
function ReadFromPipe(Pipe: THandle): string;
procedure WriteToPipe(Pipe: THandle; Value: char); overload;
{ Private declarations }
public
ReadIn, WriteIn,ReadPipe, WritePipe: THandle;
ProcessInfo: TProcessInformation;
Buffer: PChar;
BytesRead: DWord;
bStart:boolean;
s:Tstringlist;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
Security: TSecurityAttributes;
start: TStartUpInfo;
begin

// s.Destroy;
with Security do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;

{创建一个命名管道用来捕获console程序的输出}

Createpipe(ReadIn, WriteIn, @Security, 0);
if not Createpipe(ReadPipe, WritePipe, @Security, 0) then
begin
showmessage('无法创建命名管道！');
exit;
end;

Buffer := AllocMem(ReadBuffer + 1);
FillChar(Start, Sizeof(Start), #0);

{设置console程序的启动属性}
with start do
begin
cb := SizeOf(start);
start.lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwX := 0;
dwY := 0;
dwXSize := 0;
dwYSize := 0;

dwXCountChars := 0;
dwYCountChars := 0;
dwFillAttribute := 0;
cbReserved2 := 0;
lpReserved2 := nil;
hStdOutput := WritePipe; //将输出定向到我们建立的WritePipe上
hStdInput := ReadIn; //将输入定向到我们建立的ReadPipe上
hStdError := WritePipe;//将错误输出定向到我们建立的WritePipe上
dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
wShowWindow := SW_hide;//设置窗口为hide
end;

if not {CreateProcess(nil, PChar('cmd'), @Security, @Security, true,
NORMAL_PRIORITY_CLASS,
nil, nil, start, ProcessInfo) }
CreateProcess(nil,
PChar('cmd'),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)then
begin
showmessage('无法起动cmd!');
exit;
end;
Memo1.Lines.Add('程序起动');
BytesRead := 0;
self.bStart :=true;

end;
procedure TForm1.WriteToPipe(Pipe: THandle; Value: string);
var
len: integer;
BytesWrite: DWord;
Buffer: PChar;
begin
len := Length(Value) + 2;
Buffer := PChar(Value + #13#10);
WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if self.bStart then
begin
TerminateProcess(ProcessInfo.hProcess,0);
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;

procedure TForm1.WriteToPipe(Pipe: THandle; Value: char);
var
len: integer;
BytesWrite: DWord;
Buffer: PChar;
begin
len :=1;
Buffer := PChar(Value);
WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
Buf: string;
fileSize:dword;
begin
buf:= ReadFromPipe( ReadPipe);
if buf <>'' then
begin
Memo1.Lines.BeginUpdate ;
Memo1.Text := Memo1.Text + buf;


postmessage(Memo1.Handle,EM_SCROLL,SB_BOTTOM,0);
application.ProcessMessages;
memo1.SelStart := length(Memo1.Text);
Memo1.Lines.EndUpdate;
end;


end;

function TForm1.ReadFromPipe(Pipe: THandle): string;
var
Buffer: PChar;
BytesRead: DWord;
begin
Result := '';
if GetFileSize(Pipe, nil) = 0 then Exit;

Buffer := AllocMem(ReadBuffer + 1);
repeat
BytesRead := 0;
ReadFile(Pipe, Buffer[0],
ReadBuffer, BytesRead, nil);
if BytesRead > 0 then begin
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
Result := Result+string(Buffer);
end;
until (GetFileSize(Pipe, nil) <= 0);
FreeMem(Buffer);
end;
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
WriteToPipe(WriteIn,ComboBox1.Text);
Key :=#0;
ComboBox1.Items.Insert(0,ComboBox1.Text);
if (ComboBox1.Text <> '')then
begin
if ComboBox1.Items.Count > 20 then
ComboBox1.Items.Delete(ComboBox1.Items.Count -1);
ComboBox1.Text:='';
ComboBox1.ItemIndex:=-1;
end;
end;
ComboBox1.Tag:= ComboBox1.SelStart ;

end;

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
if length(ComboBox1.Text) <=ComboBox1.Tag then
ComboBox1.SelStart := ComboBox1.Tag ;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
PostMessage(ComboBox1.Handle,WM_CHAR, integer(Key),0);
Key:=#0;
ComboBox1.SetFocus;

end;

end.

多人接受答案了。