首先,利用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控制臺接受並執行