将完整的控制台信息移动到 TMemo

Question

我使用以下过程将DOS命令的结果放在TMemo中：

procedure RunDosInMemo(DosApp: String; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security : TSecurityAttributes;
  ReadPipe, WritePipe : THandle;
  start : TStartUpInfo;
  ProcessInfo : TProcessInformation;
  Buffer : Pchar;
  BytesRead : DWord;
  Apprunning : DWord;
begin
  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(DosApp),
      @Security,
      @Security,
      true,
      NORMAL_PRIORITY_CLASS,
      nil,
      nil,
      start,
      ProcessInfo)
    then
begin
  repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 200);
        Application.ProcessMessages;
      until (Apprunning <> WAIT_TIMEOUT);
  repeat
        BytesRead := 0;
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        AMemo.Text := AMemo.text + String(Buffer);
      until (BytesRead < ReadBuffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

然后，我将它与netsh.exe的副本一起使用，以获取无线信号和MAC地址的列表，如下所示：

RunDosInMemo('C:Edge LRnetsh.exe wlan show networks mode=Bssid', Memo3);

但它只显示列表中的前 9 个无线信号。当我直接在控制台上运行它时，它会显示所有无线信号和规格的完整列表。

有没有人知道如何解决这个问题？

Answer 1

如果您阅读下面的 MSDN 文档，您将看到您缺少一些非常重要的步骤：

创建具有重定向输入和输出的子进程

最值得注意的是，您将父进程的管道读取端用于子进程的 STDIN，这是错误的。 你让子进程继承管道的读取端，这也是错误的。

您还需要在子进程继承管道后关闭管道的写入端，然后再开始从管道读取。 否则，子进程将不会完全退出并发出信号 CreateProcess() 返回的句柄。通过关闭写入结束，可以确保进程可以完全终止，并且当子进程关闭其管道末端并且没有更多要读取的数据时，ReadFile()将失败并显示ERROR_BROKEN_PIPE错误。

尝试更多类似的东西：

procedure RunDosInMemo(DosApp: String; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security : TSecurityAttributes;
  ReadPipe, WritePipe : THandle;
  start : TStartUpInfo;
  ProcessInfo : TProcessInformation;
  Buffer : array of AnsiChar;
  Str: AnsiString;
  BytesRead : DWord;
  AppRunning : DWord;
begin
  with Security do begin
    nLength := SizeOf(TSecurityAttributes);
    bInherithandle := true;
    lpSecurityDescriptor := nil;
  end;
  if not CreatePipe(ReadPipe, WritePipe, @Security, 0) then RaiseLastOSError;
  try
    if not SetHandleInformation(ReadPipe, HANDLE_FLAG_INHERIT, 0) then RaiseLastOSError;
    SetLength(Buffer, ReadBuffer);
    FillChar(Start, Sizeof(Start), 0);
    start.cb := SizeOf(start);
    start.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
    start.hStdOutput := WritePipe;
    start.hStdError := WritePipe;
    start.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if not CreateProcess(nil,
        PChar(DosApp),
        @Security,
        @Security,
        true,
        NORMAL_PRIORITY_CLASS,
        nil,
        nil,
        start,
        ProcessInfo) then RaiseLastOSError;
    try
      CloseHandle(WritePipe); 
      WritePipe := 0;
      repeat
        AppRunning := MsgWaitForMultipleObjects(1, ProcessInfo.hProcess, False, 200, QS_ALLINPUT);
        if AppRunning = (WAIT_OBJECT_0 + 1) then Application.ProcessMessages;
      until (AppRunning <> WAIT_TIMEOUT);
      repeat
        BytesRead := 0;
        if not ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil) then
        begin
          if GetLastError() <> ERROR_BROKEN_PIPE then RaiseLastOSError;
          Break;
        end;
        if BytesRead = 0 then Break;
        SetString(Str, @Buffer[0], BytesRead);
        AMemo.SelStart := AMemo.GetTextLen;
        AMemo.SelLength := 0;
        AMemo.SelText := String(Str);
      until False;
    finally
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  finally
    CloseHandle(ReadPipe);
    if WritePipe <> 0 then CloseHandle(WritePipe);
  end;
end;

<</div> div class="one_answers">

你可以做：

uses
  JCLSysUtils;
procedure TForm1.HandleOutput( const Text: string );
begin
  AMemo.Lines.Add( Text );
end;
procedure TForm1.Button1Click( Sender: TObject );
begin
  AMemo.Clear;
  JCLSysUtils.Execute( 'C:Edge LRnetsh.exe wlan show networks mode=Bssid',
                       HandleOutput );
end;