控制台重定向

[SydPink]

下面代码，在D7下正常运行，输入命令后，可以接收到命令执行输出，但是XE10.1下面，输入CMD命令后没有接收到输出，只有启动CMD的时候，能接受到一次控制台的出处。XE10.1下 WriteFile 执行成功，但是读取不到执行返回。请帮忙分析下原因。




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;
const
ReadBuffer = 2000;
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.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;

[日立奔腾浪潮微软松下联想]

输出重定向到临时文件就可以了，不要那么复杂。

[BlueStorm]

function TForm1.ReadFromPipe(Pipe: THandle): string;
var
  Buffer: array[1..32767] of AnsiChar;
  BytesRead: DWord;
  aStr: AnsiString;
begin
  Result := '';
  if GetFileSize(Pipe, nil) = 0 then
    Exit;

  repeat
    BytesRead := 0;
    ReadFile(Pipe, Buffer, SizeOf(Buffer), BytesRead, nil);
    if BytesRead > 0 then
    begin
      aStr := AnsiString(Buffer);  //Buffer里面装的是Ansi字符
      SetLength(aStr, BytesRead);
      Result := Result + String(aStr);
    end;
  until (BytesRead < SizeOf(Buffer));
end;

procedure TForm1.WriteToPipe(Pipe: THandle; Value: string);
var
  BytesWrite: DWord;
  aStr: AnsiString;
begin
  aStr := AnsiString(Value + #13#10);;
  WriteFile(Pipe, aStr[1], Length(aStr), BytesWrite, nil);  //发给console的命令应该是AnsiString
end;

[BlueStorm]

一个可以不断执行命令、能读取命令输出而且隐藏的Delphi Console类:
更正：https://blog.csdn.net/BlueStorm/article/details/82690909

[BlueStorm]

一个可以不断执行命令、能读取命令输出而且隐藏的Delphi Console类:
https://mp.csdn.net/postedit/82690909

[SydPink]

在GITHUB找到个DosCommand，功能够我用了。谢谢两位。