Capture控制台在Delphi 2009及以上版本 [英] Capture Console in Delphi 2009 and above

问题描述

下面的代码适用于Delphi XE，但2400缓冲区是非常丑陋。

The code below works for Delphi XE, but the 2400 buffersize is pretty ugly.

任何人都有一些建议清洗这个程序上？

Anyone have some suggestions on cleaning this routine up ?? And making the 2400 limit disappear (without defining a 64000 buffer).

感谢

procedure TForm1.Button1Click(Sender: TObject);
begin
     CaptureConsoleOutput('c:\windows\system32\ipconfig','',Memo1);
end;

procedure TForm1.CaptureConsoleOutput（const ACommand，AParameters：String; AMemo：TMemo）;
const
CReadBuffer = 2400;
var
saSecurity：TSecurityAttributes;
hRead：THandle;
hWrite：THandle;
suiStartup：TStartupInfo;
piProcess：TProcessInformation;
pBuffer：array [0..CReadBuffer] of AnsiChar;
dRead：DWord;
dRunning：DWord;
begin
saSecurity.nLength：= SizeOf（TSecurityAttributes）;
saSecurity.bInheritHandle：= True;
saSecurity.lpSecurityDescriptor：= nil;

procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo); const CReadBuffer = 2400; var saSecurity: TSecurityAttributes; hRead: THandle; hWrite: THandle; suiStartup: TStartupInfo; piProcess: TProcessInformation; pBuffer: array[0..CReadBuffer] of AnsiChar; dRead: DWord; dRunning: DWord; begin saSecurity.nLength := SizeOf(TSecurityAttributes); saSecurity.bInheritHandle := True; saSecurity.lpSecurityDescriptor := nil;

if CreatePipe（hRead，hWrite，@saSecurity，0）then
begin
FillChar suiStartup，SizeOf（TStartupInfo），＃0）;
suiStartup.cb：= SizeOf（TStartupInfo）;
suiStartup.hStdInput：= hRead;
suiStartup.hStdOutput：= hWrite;
suiStartup.hStdError：= hWrite;
suiStartup.dwFlags：= STARTF_USESTDHANDLES或STARTF_USESHOWWINDOW;如果CreateProcess（nil，PChar（ACommand +''+ AParameters），
suiStartup.wShowWindow：= SW_HIDE;

if CreatePipe(hRead, hWrite, @saSecurity, 0) then begin FillChar(suiStartup, SizeOf(TStartupInfo), #0); suiStartup.cb := SizeOf(TStartupInfo); suiStartup.hStdInput := hRead; suiStartup.hStdOutput := hWrite; suiStartup.hStdError := hWrite; suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; suiStartup.wShowWindow := SW_HIDE;

 if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity,
   @saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess)
   then
 begin
   repeat
     dRunning  := WaitForSingleObject(piProcess.hProcess, 100);
     Application.ProcessMessages();
     repeat
       dRead := 0;
       ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
       pBuffer[dRead] := #0;

       OemToAnsi(pBuffer, pBuffer);
       AMemo.Lines.Add(String(pBuffer));
     until (dRead < CReadBuffer);
   until (dRunning <> WAIT_TIMEOUT);
   CloseHandle(piProcess.hProcess);
   CloseHandle(piProcess.hThread);
 end;

 CloseHandle(hRead);
 CloseHandle(hWrite);

end;
end;

end; end;

推荐答案

我有一些代码来做到这一点。我已经砍掉了各种不相关的位，所以这可能无法编译。但你应该得到这个想法：

I've got some code that does this. I've hacked out various irrelevant bits, so this may not compile as is. But you should get the idea:

  procedure ReadStdout(hstdout: THandle; out stdout: string);
  var
    Buffer: AnsiString;
    FileSize: DWORD;
    NumberOfBytesRead: DWORD;
  begin
    FileSize := SetFilePointer(hstdout, 0, nil, FILE_END);
    if FileSize>0 then begin
      SetLength(Buffer, FileSize);
      SetFilePointer(hstdout, 0, nil, FILE_BEGIN);
      ReadFile(hstdout, Buffer[1], FileSize, NumberOfBytesRead, nil);
      //should really check that NumberOfBytesRead=FileSize
      stdout := Buffer;
    end else begin
      stdout := '';
    end;
  end;

  function CreateFileHandle(const FileName: string): THandle;
  var
    SecurityAttributes: TSecurityAttributes;
  begin
    ZeroMemory(@SecurityAttributes, SizeOf(SecurityAttributes));
    SecurityAttributes.nLength := SizeOf(SecurityAttributes);
    SecurityAttributes.lpSecurityDescriptor := nil;
    SecurityAttributes.bInheritHandle := True;
    Result := CreateFile(
      PChar(FileName),
      GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE,
      @SecurityAttributes,
      CREATE_ALWAYS,
      FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH,
      0
    );
  end;

  procedure Execute(const ExecutableFileName, DataFileName, TempFolder: string);
  var        
    hstdin, hstdout: THandle;
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    ExitCode: DWORD;
    stdout: string;
  begin
    hstdin := CreateFileHandle(TempFolder+'stdin');
    hstdout := CreateFileHandle(TempFolder+'stdout');
    Try
      ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
      StartupInfo.cb := SizeOf(StartupInfo);
      StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      StartupInfo.wShowWindow := SW_HIDE;
      StartupInfo.hStdInput := hstdin;
      StartupInfo.hStdError := hstdout;
      if CreateProcess(
        PChar(ExecutableFileName),
        '',
        nil,
        nil,
        True,
        CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
        nil,
        PChar(TempFolder),
        StartupInfo,
        ProcessInfo
      ) then begin            
        Try
          WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
          GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
          ReadStdout(hstdout, stdout);
        Finally
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
        End;
      end else begin
        //error;
      end;
    Finally
      CloseHandle(hstdout);
      CloseHandle(hstdin);
    End;
  end;

您需要在某一时刻清理临时文件。

You'll want to clean up the temp files at some point.

这篇关于Capture控制台在Delphi 2009及以上版本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！