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

时间:2017-02-08 16:50:01

标签: delphi console wireless netsh

我正在使用以下过程将DOS命令的结果放在each

h3

然后我将它与TMemo的副本一起使用,以获得这样的无线信号和MAC地址列表:

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;

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

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

2 个答案:

答案 0 :(得分:3)

如果您阅读以下MSDN文档,您将看到缺少一些非常重要的步骤:

Creating a Child Process with Redirected Input and Output

最值得注意的是,您正在使用父流程对子进程的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;

答案 1 :(得分:1)

你可以这样做:

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;