【问题标题】:Capture Console in Delphi 2009 and aboveDelphi 2009 及更高版本中的捕获控制台
【发布时间】:2011-02-05 06:14:09
【问题描述】:

下面的代码适用于 Delphi XE,但 2400 的缓冲区大小非常难看。

有人对清理这个程序有什么建议吗??并使 2400 限制消失(不定义 64000 缓冲区)。

谢谢


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;

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;

【问题讨论】:

  • 由于功能目标似乎是捕获网卡地址,因此使用网络 API 来获得所需的结果而不是产生 IPCONFIG 不是更好吗?
  • 感谢反馈,主要目的不是调用ipconfig。这只是一个示例,表明我正在捕获 dos 输出。它可以是命令行编译器,也可以是任何其他实用程序。

标签: delphi unicode console capture


【解决方案1】:

我有一些代码可以做到这一点。我已经破解了各种不相关的位,所以这可能无法按原样编译。但是你应该明白了:

  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;

您需要在某个时候清理临时文件。

【讨论】:

  • @user296191 我刚刚编辑了我的帖子以更正 Unicode/Ansi 字符串错误。该代码来自一个尚未从 Delphi 6 移植到现代 Unicode Delphi 的单元。以前版本的ReadStdout 在 XE 上无法正常工作。请注意,这假定控制台应用程序写入 ANSI 文本。
  • @user296191 我相信现在使用的是 OemToChar 而不是 OemToAmsi。当然,您需要在 XE 中使用 OemToCharA,就像您的代码当前的方式一样。
猜你喜欢
  • 2022-01-02
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2014-07-05
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2017-12-27
相关资源
最近更新 更多