この発言は
#01273　Fermion         さんの子プロセスの標準出力をリダイレクト
に対するコメントです







■概要
　名前無しパイプを利用して、起動子プロセスの標準出力をリダイレクトする
サンプルです。Windows2000 対応版です。

■注意事項
　・Windows98SE / Windows2000Pro + Delphi5 Pro で動作確認。
　・本サンプルは、ご自身の責任においてお試し下さい。m(_"_)m

■サンプルコード
//=========================================================================
{...略...}
implementation

{$R *.DFM}

{*************************************************************************
   ExecuteCommand 例
   ・Win2K
       Appli := 'C:\WinNT\System32\CMD.EXE';
       Param := '/C dir';
   ・Win98
       Appli := '';
       Param := 'COMMAND.COM /C dir';
//***********************************************************************}
procedure ExecuteCommand( Appli, Param: String; FStrings: TStrings );
const
  BufSize = 1024;
var
  hReadPipe,
  hWritePipe: THandle;
  Buffer    : array[ 0..BufSize - 1 ] of Char;
  SA        : TSecurityAttributes;
  SD        : TSecurityDescriptor;
  PI        : TProcessInformation;
  SI        : TStartupInfo;
  {-- SecurityAttributes 設定 -------------------------------------------}
  procedure SetSecurityAttr;
  begin
    with SA do begin
      nLength        := SizeOf( TSecurityAttributes );
      bInheritHandle := True;
      if Win32Platform = VER_PLATFORM_WIN32_NT then
        begin
          InitializeSecurityDescriptor(
              @SD,
              SECURITY_DESCRIPTOR_REVISION
          );
          SetSecurityDescriptorDacl( @SD, True, nil, False );
          lpSecurityDescriptor := @SD;
        end
      else lpSecurityDescriptor := nil;
    end;{with SA do}
  end;
  {-- Command 実行 ------------------------------------------------------}
  procedure CreateProc;
  var
    pAppli, pParam: PChar;
  begin
    FillChar( SI, SizeOf( TStartupInfo ), 0 );
    FillChar( PI, SizeOf( TProcessInformation ), 0 );
    with SI do begin
      cb := SizeOf( TStartupInfo );
      dwFlags     := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      wShowWindow := SW_HIDE; // SW_MINIMIZE;
      hStdOutput  := hWritePipe;
      hStdError   := hWritePipe;
      hStdInput   := hReadPipe;
    end;{with SI do}
    if Appli = '' then pAppli := nil else pAppli := PChar( Appli );
    if Param = '' then pParam := nil else pParam := PChar( Param );
    if CreateProcess( pAppli, pParam, nil, nil, True,
                      CREATE_DEFAULT_ERROR_MODE, nil, nil, SI, PI ) then
      begin
        CloseHandle( PI.hThread );
      end
    else raise Exception.Create( 'CreateProcess に失敗しました!' );
  end;
  {-- Pipe から実行結果出力を読み出す -----------------------------------}
  procedure ReadPipe;
  var
    BytesRead, BytesAvail, ExitCode: Cardinal;
  begin
    repeat
//      Application.ProcessMessages;
      if not GetExitCodeProcess( PI.hProcess, ExitCode ) then
        begin
          FStrings.Add( 'GetExitCodeProcess に失敗しました.' );
          Exit;
        end;{if not GetExitCodeProcess(...) then}
      if not PeekNamedPipe( hReadPipe, @Buffer, BufSize, @BytesRead,
                                                   @BytesAvail, nil ) then
        begin
          FStrings.Add( 'PeekNamedPipe に失敗しました.' );
          Exit;
        end;{if not PeekNamedPipe(...) then}
      while BytesAvail > 0 do begin
        FillChar( Buffer, BufSize, 0 );
        if not ReadFile( hReadPipe, Buffer, BufSize, BytesRead, nil ) then
          begin
            FStrings.Add( 'Pipe からの読み出しに失敗しました.' );
            Exit;
          end;{if not ReadFile(...) then}
        FStrings.Text := FStrings.Text + String( Buffer );
        Dec( BytesAvail, BytesRead );
      end;{while BytesAvail > 0 do}
    until ( ExitCode <> STILL_ACTIVE );{repeat..}
    FStrings.Add( '' );
    FStrings.Add( 'Process 終了' );
  end;
  {----------------------------------------------------------------------}
begin
  FStrings.Clear;
  SetSecurityAttr;
  if CreatePipe( hReadPipe, hWritePipe, @SA, BUFSIZE ) then
    begin
      try
        CreateProc;
        try
          ReadPipe;
        finally
          CloseHandle( PI.hProcess );
        end;{try..finally..}
      finally
        CloseHandle( hWritePipe );
        CloseHandle( hReadPipe );
      end;{try..finally..}
    end
  else raise Exception.Create( 'CreatePipe に失敗しました.' );
end;
//=========================================================================

                              01/10/17(Wed) 09:14pm  Fermion [KHF03264]

 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/10/19 -

Original document by Fermion         氏 ID:(KHF03264)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。