将完整控制台信息移至 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 LR\netsh.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;

Answer 2

你可以这样做：

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 LR\netsh.exe wlan show networks mode=Bssid',
                       HandleOutput );
end;