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

2 回答

• 49

  像往常一样，Zarco Gajic有一个解决方案：Capture the output from a DOS (command/console) Window . 这是他的文章的副本，以供将来参考：

  该示例运行'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;
  

  Update: 以上示例一步读取输出 . 以下是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;
  

  回复于 2024-05-03T03:58:52+08:00
• 18

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

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

  您可以为其提供回调过程：
  TTextHandler = procedure(const Text: string) of object;

  回复于 2024-05-03T03:58:52+08:00