Moving полной информации в консоли 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

Вы можете сделать:

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; 

Answer 2

Если прочитать следующую документацию 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;