Delphi 2009 及更高版本中的捕获控制台

发布于 2024-10-16 08:45:23 字数 1852 浏览 4 评论 0原文

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

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

感谢


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

程序 TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo); 常量 CReadBuffer = 2400; 变量 saSecurity:TSecurityAttributes; hRead:THandle; hWrite:THandle; suiStartup:TStartupInfo; piProcess: TProcessInformation; pBuffer:AnsiChar 的数组[0..CReadBuffer]; dRead:双字; d运行:双字; 开始 saSecurity.nLength := SizeOf(TSecurityAttributes); saSecurity.bInheritHandle := True; saSecurity.lpSecurityDescriptor := nil;

如果 CreatePipe(hRead, hWrite, @saSecurity, 0) 那么 开始 FillChar(suiStartup, SizeOf(TStartupInfo), #0); suiStartup.cb := SizeOf(TStartupInfo); suiStartup.hStdInput := hRead; suiStartup.hStdOutput := hWrite; suiStartup.hStdError := hWrite; suiStartup.dwFlags := STARTF_USESTDHANDLES 或 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);

结尾; 结尾;

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).

Thanks


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;

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

忆离笙 2024-10-23 08:45:23

我有一些代码可以做到这一点。我已经删除了各种不相关的部分,所以这可能无法按原样编译。但您应该明白:

  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;

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

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.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文