Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年01月28日] [更新 2016年10月26日]　Delphi サンプルプログラム集
   
552_パイプを使用したコマンドラインのリダイレクト
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
552_PipeRedirect.zip　[3,576 KB]　2016年10月26日版 (EXE 同梱)



  • 2016年102月13日 (これより前の履歴は省略)
  • リダイレクトのユニット名を変更して，クラス名も変更．コードを整備
  • 関数の戻り値に TMemoryStream を使用するのを廃止．引数にした



パイプを使用したコマンドラインのリダイレクト


コマンドの実行結果を文字列またはメモリストリームで受け取るサンプルです．

コマンドプロンプトの出力先は，通常は標準出力先であるコマンドプロンプトの画面です．これを，下図のようにしてファイルに出力することもできます．これを出力先のリダイレクと言います．本ページに掲載しているリダイレクトのユニットを使用すると，文字列またはメモリストリームににリダイレクトすることができます．
リダイレクトの実装にはプロセス間通信に使用されるパイプという機能を使用しています．


図1
リダイレクトの例
  • dir コマンドの出力先を 000.txt というファイルにリダイレクト
  • コマンドの実行結果が 000.txt に出力される

[備考]
コマンドプロンプトに関しては以下の記事も参考にしてください．




01_標準出力をリダイレクト


フォームに配置した TComboBox にセットしたコマンドを実行し，その結果を TMemo に表示します．
実際には，コマンドの実行結果の文字列を，TMemo の Text プロパティに代入します．

コマンドラインには，コマンドを収めたファイルを指定できる場合があります．そのテスト用として，FTP の GET また PUT コマンドを実行する際の参考となるテストファイルも用意してあります．各自の値に書き換えてテストしてみてください．


図2
設計時画面
図3
Dir コマンドの実行例
  • プロジェクトのディレクトリのリスト
図4
FTP の GET コマンド実行例
  • 筆者のサイトから plSetPrinter.zip というファイルをダウンロード
  • ファイル FTPGet.txt にコマンド類が収めてある
図5
ファイル FTPGet.txt の内容
  • username と password に実際のユーザ名とパスワードを書く
  • その他の引数も必要に応じて変更
図6
gawkを使ってみる
  • gawk はテキスト処理用のスクリプト言語
  • ファイル data.txt 内の '言語' の文字がある行を表示
  • {print} はなくてもよい
  • 実行には gawk.exe が必要
図7
data.txt の内容

リスト1
コマンド出力のリダイレクト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Button1: TButton;
    ComboBox1: TComboBox;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  plCommandRedirect;


{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//  ファイルからテキストを読み込んで，CombooBoxにコマンド類をセット
//
//  DirTest.batはDOSのコマンドを収めたファイル(拡張子batのファイルは実行可能)
//  FTPPut.txtとFTPGet.txtはFTPによるファイルのダウンロードとアップロードを実行
//  するコマンドを収めたファイル
//
//  data.txtはgwakのテスト用のデータファイル
//  '言語'という文字がある行を検索して表示する
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LStrList : TStringList;
  i  : Integer;
begin
  LStrList := TStringList.Create;
  try
    LStrList.LoadFromFile('CommandList.txt');
    for i := LStrList.Count - 1 downto 0 do begin
      if Trim(LStrList[i]) = '' then begin
        LStrList.Delete(i);
      end else begin
        LStrList[i] := Trim(LStrList[i]);
      end;
    end;
    ComboBox1.Items.Assign(LStrList);
    ComboBox1.ItemIndex := 0;
    ComboBox1.AutoComplete := False;
  finally
    FreeAndNil(LStrList);
  end;
end;

//=============================================================================
//  リダイレクトの実行
//  出力のリダイレクト先はMemo1
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCmdRedirect : TplCommandRedirect;
  LCmdLine     : WideString;
begin
  Memo1.Clear;
  Memo1.Update;
  LCmdRedirect  := TplCommandRedirect.Create;
  Screen.Cursor := crHourGlass;

  try
    Memo1.Clear;
    LCmdLine   := ComboBox1.Text;
    Memo1.Text := LCmdRedirect.GrabStdOutText(LCmdLine);
  finally
    FreeAndNil(LCmdRedirect);
  end;
  Screen.Cursor := crDefault;
end;

end.


テストで使用している gwak (ジーオーク，グヌーオーク・グニューオーク )は，現在公開は停止しているようですが，Vector からはダウンロードできるようです．
gwak を使用する場面があるかどうかは分かりませんが，これは，Delphi のコマンドライン ユーティリティである，テキスト検索ユーティリティ： GREP.EXE のような機能が使用可能なスクリプト言語です．例えば下の図では，次のテキストファイルから，ABC と XYZ で囲まれた中に東京という文字列がある行だけを取り出しています．
スクリプト言語ですから，実行するコマンドを書いたファイルを用意して実行することもできます．例えば code.txt という実行する内容を書いたファイルを用意した場合，

gawk -f code.txt data.txt

ということもできます．


リスト2
data.txt の内容 
東京は日本の首都です 
日本の首都は東京 
明日はABC東京に出張XYZします 
大阪は商業都市です 
うまいもんなら大阪 
今日は大阪にいます


[備考 1]
GREP.EXE は，再配布不可となっています．自アプリに添付することはできません．

[備考 2]
Windows には find, findstr という検索用のコマンドがあります．findstr は正規表現も利用できますが，機能は grep と同じではありません．
コマンドプロンプトで find /? あるいは findstr /? を実行すればコマンドパラメータを調べることができます．


図8
gwak 使用例
図9
Delphi 付属 grep の使用例
  • 正規表現も使用可能




02_標準入出力をリダイレクト


コマンドプロンプトの入力部分を TMemo にしたものですが，予め記入しておいたコマンドを連続実行します．ただし，全てのコマンドでこの方法が使用できるわけではありません．

サンプルでは，コマンドプロンプトで実行するコマンドをリダイレクトしていますが，コマンドプロンプトを表示して，あるいは表示中のコマンドプロンプトに，これらのコマンドを表示 (送信) することはできません．



図10
設計時画面
図11
実行例
  • 上の TMomeo に入力したコマンドを実行した結果

リスト3
標準入出力をリダイレクト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Memo2: TMemo;
    Splitter1: TSplitter;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plCommandRedirect;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Text := 'cmd.exe /k';
  Button2Click(nil);
end;

//=============================================================================
//  リダイレクトの実行
//  コマンド類をTStrings等に格納しておく場合の参考用
//  ここでは標準入力にリダイレクトするのはMemo1のStrings(Memo1.Lines)
//  出力のリダイレクト先はMemo2
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCmdLine : TplCommandRedirect;
  LCmdStr  : String;
  LStrText : TStrings;
begin
  Memo2.Clear;
  Memo2.Update;
  LCmdLine := TplCommandRedirect.Create;
  LCmdStr  := Edit1.Text;
  Screen.Cursor := crHourGlass;

  try
    //コマンドプロンプトでの[Enter]の代わり
    if Memo1.Lines[Memo1.Lines.Count -1 ] <> '' then begin
      Memo1.Lines.Add('');
    end;

    LStrText   := Memo1.Lines;
    Memo2.Text := LCmdLine.GrabStdOutText(LCmdStr, LStrText);
  finally
    FreeAndNil(LCmdLine);
  end;
  Screen.Cursor := crDefault;
end;

//=============================================================================
//  入力のりダイレクト元であるMemo1の内容をクリア
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.SetFocus;
end;

end.



03_ユニコード文字列のリダイレクトと /U オプション


下図は添付のプロジェクトのフォルダ内を Dir コマンドで表示した結果です．
「你好」という中国簡体字が表示されています．


図12
Dir コマンド実行

ところが，Dir コマンドをリダイレクトして，000.txt というファイルに保存すると，下図のように，「你好」という文字列が 「?好」という文字になって，ユニコード文字が正常に出力されていないことが分かります．


図13
Dir のリダイレクト
図14
リダイレクトの結果
  • 「你好」が「?好」となっている

この現象は，添付のリダイレクトのユニットを使用して，リダイレクトの結果を文字列として取得する場合も全く同じです．下図はその結果です．


図15
リダイレクト結果の文字列

ユニコード文字もリダイレクトして取得するには，コマンドラインに /U スイッチを指定します．更にリダイレクトの結果をメモリストリームで受け取り，ユニコードにエンコードするといいようです．
次のコードは，その実際のサンプルです．「你好」が正常に取得できています．

結果的に，リダイレクトの結果はメモリストリームで取得して，コードページをエンコード処理すればいいことになります．コマンドラインのリダイレクトが，デフォルトでユニコードに対応していないことを，2013年12月23日の更新まで筆者は知りませんでした．そこで，2013年12月23日の更新で，メモリストリームで取得するメソッドを追加しました．
ユニコードを処理する必要がなければ，String 型で取得するメソッドでも十分です．


図16
ユニコード文字列も取得

リスト4
ユニコード文字列をリダイレクトするためのコード 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  plCommandRedirect;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Text := 'cmd.exe /U /k dir';
end;

//=============================================================================
//  リダイレクトの実行
//  TMemoryStreamで受け取ったリダイレクトの結果をTStringListでエンコード処理
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCmdRedirect : TplCommandRedirect;
  LStream      : TMemoryStream;
  LCmdStr      : string;
  LStrList     : TStringList;
begin
  Memo1.Clear;
  Memo1.Update;

  LCmdRedirect := TplCommandRedirect.Create;

  Screen.Cursor := crHourGlass;
  LStream  := TMemoryStream.Create;
  LStrList := TStringList.Create;
  try
    LCmdStr := Trim(Edit1.Text);

    //TMemoryStreamにリダイレクトされた内容をTStringListで取得
    LCmdRedirect.GrabStdOutStream(LCmdStr, LStream);

    if (Pos(' /U ', LCmdStr) > 0) or (Pos(' /u ', LCmdStr) > 0) then begin
      LStrList.LoadFromStream(LStream, TEncoding.Unicode);
    end else begin
      LStrList.LoadFromStream(LStream);
    end;

    Memo1.Lines := LStrList;
  finally
    FreeAndNil(LCmdRedirect);
    FreeAndNil(LStrList);
    FreeAndNil(LStream);
  end;
  Screen.Cursor := crDefault;
end;

end.



04_使用したリダイレクトのユニット


Fusa さんが提供している CommandLineUnit を参考にして，Delphi 2009 以降でも使用可能なようにしています．


[備考 1]
コマンドラインのリダイレクトとなっていますが，GUI のプログラムが実行できないことを除けば実質的に [ファイル名を指定して実行] の機能と同じです．そのため，コマンドプロセッサ (コマンドプロンプト) の内部コマンドを実行する時は cmd.exe /k を最初に指定する必要があります．こうすることにより，コマンドプロンプトのオプションや動作の指定を可能にしています．

[備考 2]
基本的に起動するアプリ，プログラムの EXE 名をフルパスで指定しますが，システム的にパスが通った場所にあるアプリ，プログラムは，ディレクトリ名を省略しても起動できます．



リスト5
本ユニットの動作確認は Delphi 6 ～ Delphi XE (全て Pro 版)
原理的に GUI のプログラムは実行できない．実行するとハングアップする (固まる)		 
unit plCommandRedirect;

interface

uses
  SysUtils, Windows, Classes, Forms, Dialogs;

type
  TplCommandRedirect = class
  private
    FLoopProcessMessages: Boolean;
    function GrabStdOut(ACommandLine: string;
      AStream: TMemoryStream; AOutStream: TMemoryStream): Boolean;
    function GetStringFromStream(const Stream: TStream): String;
  public
    constructor Create;
    function GrabStdOutStream(CommandLine: string;
      AOutMemory: TMemoryStream): Boolean; virtual;
    function GrabStdOutText(CommandLine: string): String; overload;
    function GrabStdOutText(CommandLine: string; StdInput: TStrings):
      String; overload;
    property LoopProcessMessages: Boolean read FLoopProcessMessages
                                          write FLoopProcessMessages;
  end;

implementation

//-----------------------------------------------------------------------------
//  実際にコマンドラインのコマンドを実行してリダイレクトする関数
//-----------------------------------------------------------------------------
function TplCommandRedirect.GrabStdOut(ACommandLine: string;
  AStream: TMemoryStream; AOutStream: TMemoryStream): Boolean;
const
  BUFFER_SIZE = 8192;
var
  LhStdInRead     : THandle;
  LhStdInWrite    : THandle;
  LhStdInWriteDup : THandle;
  LhStdOutRead    : THandle;
  LhStdOutWrite   : THandle;
  LhStdReadErr    : THandle;
  LhStdWriteErr   : THandle;
  LSecutityAttrib : TSecurityAttributes;
  LStartupInfo    : TStartupInfo;
  LProcessInfo    : TProcessInformation;
  LStreamBuffSize : DWord;
  LWriteSize      : Cardinal;
  LdwRet          : DWORD;
  LdwReadSize     : DWORD;
  LBuffStdIn      : array [0..BUFFER_SIZE - 1] of Byte;
  LBuffStdOut     : array [0..BUFFER_SIZE - 1] of Byte;
  LBuffStdErr　　 : array [0..BUFFER_SIZE - 1] of Byte;
begin
  Result := False;

  //初期化
  LhStdInRead     := 0;
  LhStdInWrite    := 0;
  LhStdInWriteDup := 0;
  LhStdOutRead    := 0;
  LhStdOutWrite   := 0;
  LhStdReadErr    := 0;
  LhStdWriteErr   := 0;

  //TSecurityAttributesメンバ設定
  LSecutityAttrib.nLength              := SizeOf(TSecurityAttributes);
  LSecutityAttrib.bInheritHandle       := True;
  LSecutityAttrib.lpSecurityDescriptor := nil;

  //exitでもハンドルをCloseするためにtry-finallyを使用
  try
    //StdIn(標準入力)用パイプを生成してハンドルを取得
    if not CreatePipe(LhStdInRead,
                      LhStdInWrite,
                      @LSecutityAttrib,
                      BUFFER_SIZE) then begin
      //StdIn用パイプ生成エラー(必要ならエラー表示あるいは関数に引数を追加)
      exit;
    end;

    //標準入力の書き込み(Write)を継承しないようにする
    //そのためDuplicateHandleで継承しない複製を作成
    //この処理をしないと余分なリダイレクト結果が取得されることがある
    DuplicateHandle(GetCurrentProcess,
                    LhStdInWrite,
                    GetCurrentProcess,
                    @LhStdInWriteDup,
                    0,
                    False,
                    DUPLICATE_SAME_ACCESS);
    //元Writeは不要なのでクローズ
    CloseHandle(LhStdInWrite);

    //StdOut(標準出力)パイプを生成してハンドルを取得
    if not CreatePipe(LhStdOutRead,
                      LhStdOutWrite,
                      @LSecutityAttrib,
                      BUFFER_SIZE) then begin
      //StdOut(標準出力)用パイプ生成エラー
      exit;
    end;

    //StdError(標準エラー)用パイプを生成してハンドルを取得
    if not CreatePipe(LhStdReadErr,
                      LhStdWriteErr,
                      @LSecutityAttrib,
                      BUFFER_SIZE) then begin
      //StdError(標準エラー)用パイプ生成エラー
      exit;
    end;


    //CreateProcess関数用の引数設定
    //SW_SHOWにしてもSTARTF_USESTDHANDLESフラグがある時はウィンドウは表示しない
    ZeroMemory(@LStartupInfo, SizeOf(TStartupInfo));
    ZeroMemory(@LProcessInfo, SizeOf(TProcessInformation));
    LStartupInfo.cb          := SizeOf(TStartupInfo);
    LStartupInfo.hStdInput   := LhStdInRead;
    LStartupInfo.hStdOutput  := LhStdOutWrite;
    LStartupInfo.hStdError   := LhStdWriteErr;
    LStartupInfo.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    LStartupInfo.wShowWindow := SW_SHOWNORMAL;

    //ハンドルをCloseするためにtry-finallyを使用
    try
      UniqueString(ACommandLine);
      if not CreateProcess(nil,
                           PChar(ACommandLine),
                           @LSecutityAttrib,
                           nil,
                           True,
                           CREATE_NO_WINDOW,
                           nil,
                           nil,
                           LStartupInfo,
                           LProcessInfo) then begin
        //CreateProcess失敗
        exit;
      end;

      //入力待ちになるまで待つ
      WaitForInputIdle(LProcessInfo.hProcess, 1000);
      LStreamBuffSize := BUFFER_SIZE;
      while LStreamBuffSize = BUFFER_SIZE do begin
        //標準入力にコマンドをリダイレクトする場合
        //主な用途はcmd.exeに対するコマンドの実行
        AStream.Position := 0;
        LStreamBuffSize := AStream.Read(LBuffStdIn, BUFFER_SIZE);
        WriteFile(LhStdInWriteDup, LBuffStdIn, LStreamBuffSize, LWriteSize, nil);
      end;
      //パイプへの書き込みが終わったらハンドルを閉じる
      CloseHandle(LhStdInWriteDup);


      //標準出力のリダイレクト結果を取得
      //バッファのサイズ内であればループは1回のみ
      AOutStream.Clear;
      repeat
        //取得に失敗する場合,少しタイムラグを持たせるとOKの時がある
        if FLoopProcessMessages then begin
          Application.ProcessMessages;
          Sleep(50);
        end;

        //標準出力パイプの内容を調べてサイズが1以上なら読み取る
        PeekNamedPipe(LhStdOutRead, nil, 0, nil, @LdwReadSize, nil);
        if (LdwReadSize > 0) then begin
          ReadFile(LhStdOutRead, LBuffStdOut, SizeOf(LBuffStdOut), LdwReadSize, nil);
          AOutStream.Write(LBuffStdOut, LdwReadSize);
        end;

        //同様に標準エラー内容の取得
        //エラー時は上のLhStdOutReadの出力はないのでループはエラー取得の1回のみ
        PeekNamedPipe(LhStdReadErr, nil, 0, nil, @LdwReadSize, nil);
        if (LdwReadSize > 0) then begin
          ReadFile(LhStdReadErr, LBuffStdErr, SizeOf(LBuffStdErr), LdwReadSize, nil);
          AOutStream.Write(LBuffStdErr, LdwReadSize);
        end;

        LdwRet := WaitForSingleObject(LProcessInfo.hProcess, 0);
      until LdwRet = WAIT_OBJECT_0;

      Result := True;
    finally
      TerminateProcess(LProcessInfo.hProcess, 0);
      CloseHandle(LProcessInfo.hProcess);
      CloseHandle(LProcessInfo.hThread);
    end;
  finally
    if LhStdInRead <> 0   then CloseHandle(LhStdInRead);
    if LhStdOutRead <> 0  then CloseHandle(LhStdOutRead);
    if LhStdOutWrite <> 0 then CloseHandle(LhStdOutWrite);
    if LhStdReadErr <> 0  then CloseHandle(LhStdReadErr);
    if LhStdWriteErr <> 0 then CloseHandle(LhStdWriteErr);
  end;
end;

//-----------------------------------------------------------------------------
constructor TplCommandRedirect.Create;
begin
  FLoopProcessMessages := False;
end;

//-----------------------------------------------------------------------------
//  Unicode(Delphi2009以降に対応
//  取得した文字コードを変更しないようにRawByteStringで定義した文字列に読み込む
//  その後結果の文字列に代入する
//-----------------------------------------------------------------------------
function TplCommandRedirect.GetStringFromStream(const Stream: TStream): string;

//Delphi 2009以降
{$IFDEF Unicode}
var
  LpBuffer   : Integer;
  LStrBuffer : RawByteString;
begin
  Stream.Read(LpBuffer, SizeOf(Integer));
  SetLength(LStrBuffer, LpBuffer);
  Stream.Position := 0;
  Stream.Read(Pointer(LStrBuffer)^, LpBuffer * SizeOf(Char));

  //→UTF-16なのでロスレス変換なのだけれども
  //単純に代入するとコンパイラがワーニングを吐くのでキャスト
  Result := UnicodeString(LStrBuffer);
end;

//Delphi 2007以前
{$ELSE}
begin
  SetLength(Result, Stream.Size);
  Stream.Position := 0;
  Stream.ReadBuffer(Result[1], Stream.Size);
end;
{$ENDIF}

//-----------------------------------------------------------------------------
//  外部から利用する公開関数　
//  出力先だけをリダイレクトする場合
//  結果を文字列で取得
//-----------------------------------------------------------------------------
function TplCommandRedirect.GrabStdOutText(CommandLine: string): string;
var
  LStreamIn  : TMemoryStream;
  LStreamOut : TMemoryStream;
begin
  Result := '';

  LStreamIn  := TMemoryStream.Create;
  LStreamOut := TMemoryStream.Create;
  try
    if GrabStdOut(CommandLine, LStreamIn, LStreamOut) then begin
      Result := GetStringFromStream(LStreamOut);
    end;
  finally
    FreeAndNil(LStreamOut);
    FreeAndNil(LStreamIn);
  end;
end;

//-----------------------------------------------------------------------------
//  外部から利用する公開関数　
//  入力と出力をリダイレクトする場合
//  結果を文字列で取得
//-----------------------------------------------------------------------------
function TplCommandRedirect.GrabStdOutText(CommandLine: string;
  StdInput: TStrings): string;
var
  LStreamIn  : TMemoryStream;
  LStreamOut : TMemoryStream;
begin
  Result := '';

  LStreamIn  := TMemoryStream.Create;
  LStreamOut := TMemoryStream.Create;
  StdInput.SaveToStream(LStreamIn);
  try
    if GrabStdOut(CommandLine, LStreamIn, LStreamOut) then begin
      Result := GetStringFromStream(LStreamOut);
    end;
  finally
    FreeAndNil(LStreamOut);
    FreeAndNil(LStreamIn);
  end;
end;

//-----------------------------------------------------------------------------
//  外部から利用する公開関数　
//  コマンドの実行結果として出力だけをリダイレクトする場合
//  TMemoryStreamで取得
//  TMemoryStreamの生成と破棄は呼び出し側で行う
//-----------------------------------------------------------------------------
function TplCommandRedirect.GrabStdOutStream(CommandLine: string;
  AOutMemory: TMemoryStream): Boolean;
var
  LStreamIn : TMemoryStream;
begin
  LStreamIn := TMemoryStream.Create;
  try
    Result := GrabStdOut(CommandLine, LStreamIn, AOutMemory);
    AOutMemory.Position := 0;
  finally
    FreeAndNil(LStreamIn);
  end;
end;

end.



05_TJvCreateProcess を使用したコマンドラインのリダイレクト


JEDI プロジェクトの TJvCreateProcess を使用すると，コマンドラインのリダイレクトの機能が簡単に実装できます．そのサンプルです．

上のリダイレクトのユニットでは，コマンドを実行するたびに CreateProcess 関数でコマンドを実行します．したがって，cmd.exe の内部コマンドの実行には cmd.exe が必要です．
一方，本サンプルでは TJvCreateProcess.Run メソッドを実行すると，コマンドプロンプトを非表示で起動するようになっています．その起動中のコマンドプロンプトに対してコマンドを送信して実行します．したがって，cmd.exe の内部コマンドの実行に cmd.exe を指定する必要はありません．



本サンプルは，コマンドの入力が TEdit というだけで，TMemo にはリダイレクトされた内容がそのまま表示されます．同じ様な機能のプログラムを作成することもできますが，その機能が非ビジュアルコンポーネントとして利用できるのは便利です．

起動中のコマンドプロンプト (コマンドプロセッサ) 対してコマンドを実行するのですから，GUI のプログラムも起動できます．



図17
設計時画面
図18
サンプルの EXE 起動時
図19
dir コマンドの実行結果
  • cmd.exe の内部コマンドだけでなく，Windows のコマンドも普通に実行できる

下図はリダイレクトの結果を表示するコントロールの背景色等を変えてみた結果です．
コマンドプロンプトとは違い，フォントのサイズや色，フォント名も，ウインドウのサイズも自由に変更できます．コマンドの実行結果をコマンドプロンプトで表示する必要がある場合に，代用として利用できるかも知れません．ただし，TMemo に表示されるのはリダイレクトの結果だけです．コマンドプロンプトの画面に表示される全てが TMemo に表示されるわけではありません．


図20
コマンドプロンプト風

リスト6
TJvCreateProcess を使用したコマンドラインのリダイレクト		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, JvComponentBase, JvCreateProcess;

type
  TForm1 = class(TForm)
    JvCreateProcess1: TJvCreateProcess;
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure JvCreateProcess1Read(Sender: TObject; const S: string;
      const StartsOnNewLine: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  JclSysInfo;

{$R *.dfm}

//=============================================================================
//  TJvCreateProcessを使用したコマンドラインのリダイレクト
//
//  フォーム生成時の処理
//  TJvCreateProcessの各種設定(オブジェクトインスペクタでも設定可能
//
//  usesにJclSysInfoが必要
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LCommandLine : string;
begin
  Memo1.Lines.Clear;
  Button1.Default := True;
  ActiveControl := Edit1;

  //コマンドプロセッサの指定(パス名)
  JclSysInfo.GetEnvironmentVar('COMSPEC', LCommandLine);
  JvCreateProcess1.CommandLine := LCommandLine;

  //コマンドプロンプトでの実行結果をイベントで受け取るようにする
  JvCreateProcess1.ConsoleOptions := JvCreateProcess1.ConsoleOptions + [coRedirect];

  //コマンドプロンプトを非表示で起動する指定
  JvCreateProcess1.StartupInfo.ShowWindow := swHide;
  JvCreateProcess1.StartupInfo.DefaultWindowState := False;

  //コマンドプロンプトを起動)
  JvCreateProcess1.Run;
end;

//=============================================================================
//  Edit1のテキストをコマンドとして実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if LowerCase(Trim(Edit1.Text)) = 'cls' then begin
    Memo1.Lines.Clear;
    JvCreateProcess1.WriteLn('');
  end else begin
    JvCreateProcess1.WriteLn(AnsiString(Edit1.Text));
  end;
end;

//=============================================================================
//  JvCreateProcess1のOnReadイベント処理
//  実行結果を受け取ってMemo1に表示
//=============================================================================
procedure TForm1.JvCreateProcess1Read(Sender: TObject; const S: string;
  const StartsOnNewLine: Boolean);
begin
  if StartsOnNewLine then begin
    Memo1.Lines.Add(S);
  end else begin
    Memo1.Lines[Memo1.Lines.Count - 1] := S;
  end;
end;

end.