Delphi中利用管道重定向实现对控制台(Console)程序的操作

测试目标: 设计一个虚拟的Dos控制台,包含一个Memo和一个ComboBox,要求可以在ComboBox中输入Dos命令,然后由系统捕获命令输出的结果显示在Memo中.

程序设计思路:

首先,利用WIN API函数 Createpipe 建立两个管道(Pipe),然后建立利用CreateProcess函数创建一个控制台程序的进程（这里使用的是Win2000的Dos控制台 cmd.exe）,并且在StartUpInfo参数中指定用刚才建立的三个管道替换标准的输入hStdOutput、输出hStdInput以及错误输出设备hStdError。

代码如下：

procedure TForm1.InitConsole;
var
Security: TSecurityAttributes;
start: TStartUpInfo;
begin
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;

Createpipe(ReadOut, WriteOut, @Security, 0);
Createpipe(ReadIn, WriteIn, @Security, 0);

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

FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
start.hStdOutput := WriteOut;
start.hStdInput := ReadIn;
start.hStdError := WriteOut;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;

CreateProcess(nil,
PChar('cmd'),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
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 := string(Buffer);
end;
until (BytesRead < ReadBuffer);
FreeMem(Buffer);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
begin
s := ReadFromPipe(ReadOut);
if s <> '' then begin
Memo1.Lines.Text := Memo1.Lines.Text + s;
Memo1.SelStart := Length(Memo1.Lines.Text);
Memo1.SelLength := 0;
end;
end;

在下方的输入框内输入命令之后，则通过向输入设备对应的管道发送命令来实现命令行的输入，代码如下：

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

procedure TForm1.Button1Click(Sender: TObject);
begin
if Trim(cbCmd.Text) <> '' then begin
WriteToPipe(WriteIn, cbCmd.Text);
if cbCMD.ItemIndex > -1 then
cbCMD.Items.Delete(cbCMD.ItemIndex);
cbcmd.Items.Insert(0, cbCmd.Text);
cbCmd.Text:='';
end;
end;

这里要注意的是发送命令行的时候必须添加换行字符#10，才能被Dos控制台接受并执行