将 shell/dos 应用程序的输出获取到 Delphi 应用程序

Question

我有一个用 delphi 编码的命令行应用程序，我需要从普通的桌面应用程序（也用 delphi 编码）调用它。简而言之，我想调用命令行应用程序并在列表框中“实时”显示它输出的文本。

我已经很久没有使用 shell 了，但我清楚地记得，为了从命令行应用程序中获取文本 - 我必须使用管道符号“>”。像这样：

C:/mycmdapp.exe >c:/result.txt

这会将打印到 shell 的任何文本（使用 writeLn）并将其转储到名为“result.txt”的文本文件中。

但是..（这是泡菜），我想要一个实时结果而不是一个积压文件。一个典型的例子是 Delphi 编译器本身 - 它设法向 IDE 报告正在发生的情况。如果我没记错的话，我似乎记得我必须创建一个“管道”通道（？），然后将管道名称分配给 shell 调用。

我试着用谷歌搜索这个，但老实说我不确定如何表述它。希望社区中的有人能为我指明正确的方向。

更新：此问题可能与如何在 Delphi 中运行命令行程序？。尽管标题和问题本身并不相同，但有些答案符合我正在寻找的内容。

Answer 1

一如既往，Zarco Gajic 有一个解决方案： 捕获 DOS 的输出（命令/控制台）窗口。这是他的文章的副本，以供将来参考：

该示例运行“chkdsk.exe c:\”并将输出显示到 Memo1。
将 TMemo (Memo1) 和 TButton (Button1) 放在表单上。将此代码放入 Button1 的 OnCLick 事件过程中：

procedure RunDosInMemo(DosApp: string; AMemo:TMemo);
const
    READ_BUFFER_SIZE = 2400;
var
    Security: TSecurityAttributes;
    readableEndOfPipe, writeableEndOfPipe: THandle;
    start: TStartUpInfo;
    ProcessInfo: TProcessInformation;
    Buffer: PAnsiChar;
    BytesRead: DWORD;
    AppRunning: DWORD;
begin
    Security.nLength := SizeOf(TSecurityAttributes);
    Security.bInheritHandle := True;
    Security.lpSecurityDescriptor := nil;

    if CreatePipe({var}readableEndOfPipe, {var}writeableEndOfPipe, @Security, 0) then
    begin
        Buffer := AllocMem(READ_BUFFER_SIZE+1);
        FillChar(Start, Sizeof(Start), #0);
        start.cb := SizeOf(start);

        // Set up members of the STARTUPINFO structure.
        // This structure specifies the STDIN and STDOUT handles for redirection.
        // - Redirect the output and error to the writeable end of our pipe.
        // - We must still supply a valid StdInput handle (because we used STARTF_USESTDHANDLES to swear that all three handles will be valid)
        start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
        start.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //we're not redirecting stdInput; but we still have to give it a valid handle
        start.hStdOutput := writeableEndOfPipe; //we give the writeable end of the pipe to the child process; we read from the readable end
        start.hStdError := writeableEndOfPipe;

        //We can also choose to say that the wShowWindow member contains a value.
        //In our case we want to force the console window to be hidden.
        start.dwFlags := start.dwFlags + STARTF_USESHOWWINDOW;
        start.wShowWindow := SW_HIDE;

        // Don't forget to set up members of the PROCESS_INFORMATION structure.
        ProcessInfo := Default(TProcessInformation);

        //WARNING: The unicode version of CreateProcess (CreateProcessW) can modify the command-line "DosApp" string. 
        //Therefore "DosApp" cannot be a pointer to read-only memory, or an ACCESS_VIOLATION will occur.
        //We can ensure it's not read-only with the RTL function: UniqueString
        UniqueString({var}DosApp);

        if CreateProcess(nil, PChar(DosApp), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, start, {var}ProcessInfo) then
        begin
            //Wait for the application to terminate, as it writes it's output to the pipe.
            //WARNING: If the console app outputs more than 2400 bytes (ReadBuffer),
            //it will block on writing to the pipe and *never* close.
            repeat
                Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
                Application.ProcessMessages;
            until (Apprunning <> WAIT_TIMEOUT);

            //Read the contents of the pipe out of the readable end
            //WARNING: if the console app never writes anything to the StdOutput, then ReadFile will block and never return
            repeat
                BytesRead := 0;
                ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, {var}BytesRead, nil);
                Buffer[BytesRead]:= #0;
                OemToAnsi(Buffer,Buffer);
                AMemo.Text := AMemo.text + String(Buffer);
            until (BytesRead < READ_BUFFER_SIZE);
        end;
        FreeMem(Buffer);
        CloseHandle(ProcessInfo.hProcess);
        CloseHandle(ProcessInfo.hThread);
        CloseHandle(readableEndOfPipe);
        CloseHandle(writeableEndOfPipe);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin {button 1 code}
   RunDosInMemo('chkdsk.exe c:\',Memo1);
end;

更新：
上面的示例一步读取输出。这是 DelphiDabbler 中的另一个示例，显示了如何在进程仍在运行时读取输出：

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

Answer 2

您的硬盘上可能已经有代码：JCL（JEDI 代码库）的 JclSysUtils 单元中的 Execute 函数可以满足您的需要：

function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; 
  RawOutput: Boolean = False; AbortPtr: PBoolean = nil): Cardinal;

您可以为其提供回调过程：
TTextHandler = 对象的过程(const Text: string);

Answer 3

为了更好地理解，也做了一个答案：

{type TTextHandler =} procedure TTextHandlerQ(const aText: string);
 begin
   memo2.lines.add(atext);
 end;  

writeln(itoa(JExecute('cmd /C dir *.*',@TTextHandlerQ, true, false))); 

您必须使用 /C 然后 cmd /c 用于在 MS-DOS 中运行命令并在命令或进程完成后终止，否则它会阻止输出到备忘录。

Answer 4

我遇到了这个流行的解决方案，但它有点有问题。以下是解决该问题的一些更改，并删除了 VCL 部分：

procedure ExecStdOutCmd(DosApp: string; Strings: TStrings);
const
  READ_BUFFER_SIZE = $400; // 1K
  BUFFER_SIZE_START = $1000; // 4K
var
  Security: TSecurityAttributes;
  ReadableEndOfPipe, WriteableEndOfPipe: THandle;
  Start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PAnsiChar;
  BytesRead: DWORD;
  AppRunning: DWORD;
  BufferOffset: DWORD;
  BufferSize: DWORD;
  PeekBytes: DWORD;
  BuffStr: string;
  DosAppCStr: array [0..MAX_PATH] of Char;
begin
  Security.nLength := SizeOf(TSecurityAttributes);
  Security.bInheritHandle := True;
  Security.lpSecurityDescriptor := nil;

  if CreatePipe(ReadableEndOfPipe, WriteableEndOfPipe, @Security, 0) then
    begin
      FillChar(Start, Sizeof(Start), 0);
      Start.cb := SizeOf(Start);

      // Set up members of the STARTUPINFO structure.
      // This structure specifies the STDIN and STDOUT handles for redirection.
      // - Redirect the output and error to the Writeable end of our pipe.
      // - We must still supply a valid StdInput handle (because we used STARTF_USESTDHANDLES to swear that all three handles will be valid)
      Start.dwFlags := STARTF_USESTDHANDLES;
      Start.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //we're not redirecting stdInput; but we still have to give it a valid handle
      Start.hStdOutput := WriteableEndOfPipe; //we give the Writeable end of the pipe to the child process; we read from the Readable end
      Start.hStdError := WriteableEndOfPipe;

      //We can also choose to say that the wShowWindow member contains a value.
      //In our case we want to force the console window to be hidden.
      Start.dwFlags := Start.dwFlags or STARTF_USESHOWWINDOW;
      Start.wShowWindow := SW_HIDE;


      //WARNING: The unicode version of CreateProcess (CreateProcessW) can modify the command-line "DosApp" string.
      //Therefore "DosApp" cannot be a pointer to read-only memory, or an ACCESS_VIOLATION will occur.
      StrPLCopy(DosAppCStr, DosApp, MAX_PATH);

      if CreateProcess(nil, DosAppCStr, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, Start, ProcessInfo) then
        begin

          //Wait for the application to terminate, as it writes it's output to the pipe.
          repeat
            Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
          until (Apprunning <> WAIT_TIMEOUT);

          //Read the contents of the pipe out of the Readable end
          BufferOffset := 0;
          BufferSize := BUFFER_SIZE_START;
          GetMem(Buffer, BufferSize);

          repeat
            // if the commands return 0 bytes, or zero remain in the iteration, then peek and break.
            if not PeekNamedPipe(ReadableEndOfPipe, nil, 0, nil, @PeekBytes, nil) or (PeekBytes = 0) then
              Break;
            if not ReadFile(ReadableEndOfPipe, Buffer[BufferOffset], READ_BUFFER_SIZE, BytesRead, nil) then
              Break;
            BufferOffset := BufferOffset + BytesRead;
            if BufferOffset = BufferSize then
              begin
                // Realloc mem if we need more space
                BufferSize := 2 * BufferSize;
                ReAllocMem(Buffer, BufferSize);
              end;
          until (BytesRead < READ_BUFFER_SIZE);  // no more data?

          Buffer[BufferOffset] := #0;
          OemToCharBuffA(Buffer,Buffer,BufferOffset);
          SetString(BuffStr, Buffer, BufferOffset);
          Strings.Text := BuffStr;
          FreeMem(Buffer);
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
        end;
      CloseHandle(ReadableEndOfPipe);
      CloseHandle(WriteableEndOfPipe);
    end;
end;