[ 506_コマンドプロンプト画面に表示中のテキストを取得 ]

Delphi Programming / Object Pascal

[掲載 2016年10月24日] [更新 2016年10月24日]　Delphi サンプルプログラム集

506_コマンドプロンプト画面に表示中のテキストを取得
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro

506_GetCmdPromptText.zip　[1,088 KB]　2016年10月24日版 (EXE 同梱)

コマンドプロンプト画面に表示中のテキストを取得
01_コマンドプロンプトからコマンドとして実行
02_起動中のコマンドプロンプト画面のテキストを取得

コマンドプロンプト画面に表示中のテキストを取得

コマンドプロンプト画面に表示中のテキストを取得するサンプルです。
取得するテキストは、下図の画面のバッファに格納されているテキストです。バッファサイズを超えるテキストは取得できません。

dir コマンドを実行すると、ファイル数の多いディレクトリでバッファサイズ内に収まらないことがあります。それらは取得できないことになります。そのような結果を全て取得したいのであれば、リダイレクトの機能を使用することになるでしょう。

 help dir   //dirコマンドのヘルプ
 dir | clip //コマンドの実行結果をクリップボードにリダイレクト(コピー)
 dir > D:\000\dir.txt   //実行結果をテキストファイルにリダイレクト(保存)
 dir >> D:\000\dir.txt  //実行結果をキストファイルに追加リダイレクト(追加保存)

図1
画面バッファ内のテキストを取得

このコマンドプロンプトでは最大
80 x 500 = 4000 文字 (半角相当)

01_コマンドプロンプトからコマンドとして実行

コマンドプロンプトからコマンドとして実行するプログラムとして作成してみました。
プログラム名は GetText としています。コマンドプロンプトからこのプログラムを実行すると、フォームを表示して TMemo に取得したテキストを表示します。

	図2 コマンドプロンプトを起動
	図3 GetText を実行

次のリストは本プログラムのプロジェクトのソースコードです。
コマンドプロンプトから実行しないと正常に動作しないので、EXE を直接実行した場合はダイアログを表示します。こうしておけば少しは親切かも知れません。

本サンプルでは、EXE をコマンドプロンプトから起動したかを判定するのに、標準出力が有効になっているかで判定しています。コマンドプロンプトが起動しているかだけでは判定できません。
コマンドプロンプトから起動する EXE がコンソールアプリの場合は、この方法では判定できません。

図4
EXE を単独で起動した場合

リスト1
コマンドプロンプトから起動してコマンドプロンプトの画面のテキストを取得
プロジェクトのソースコード

program GetText;

uses
  Forms,
  Windows,
  GetTextUnit in 'GetTextUnit.pas';

{$R *.res}

var
  Ltext : string;

begin
  if GetStdHandle(STD_OUTPUT_HANDLE) = 0 then begin
    LText := 'コマンドプロンプトから実行してください';
    MessageBox(0, PChar(Ltext), '情報', MB_ICONINFORMATION);
  end else begin
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
end.

リスト2
コマンドプロンプトから起動してコマンドプロンプトの画面のテキストを取得

unit GetTextUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function AttachConsole(dwProcess: DWORD): BOOL; stdcall; external 'kernel32.dll';

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  コマンドプロンプト画面のテキストバッファの値を取得してTMemoに表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  ATTACH_PARENT_PROCESS = DWORD(-1);
var
  LhStdOutput : THandle;
  LBufferInfo : TConsoleScreenBufferInfo;
  LpCaracter  : PChar;
  LCurCoord   : TCoord;
  LTextLength : Cardinal;
  LReadCnt    : Cardinal;
  LStrList    : TStringList;
  i           : Integer;
begin
  Memo1.Lines.Clear;

  //コンソールのプロセスにアタッチして標準出力のハンドルを取得
  //コマンドプロンプトから起動したので親はコンソール
  if AttachConsole(ATTACH_PARENT_PROCESS) then begin
    LhStdOutput := GetStdHandle(STD_OUTPUT_HANDLE);

    //バッファの情報を取得
    GetConsoleScreenBufferInfo (LhStdOutput, LBufferInfo);

    LTextLength := LBufferInfo.dwSize.X;
    LStrList    := TStringList.Create;

    //メモリの確保(PChar型で受け取る時はメモリの確保が必要)
    GetMem(LpCaracter, LTextLength);
    try
      //バッファの値の読み取り位置
      //X座標は常に左端
      LCurCoord.X := 0;
      //標準出力バッファの内容を1行づつ読み出していく
      for i := 0 to LBufferInfo.dwSize.Y - 1 do begin
        LCurCoord.Y := i;
        if ReadConsoleOutputCharacter(LhStdOutput,
                                      LpCaracter,
                                      LTextLength,
                                      LCurCoord,
                                      LReadCnt) then begin
          //読み出した分だけにしないと後部にゴミが入ることがある
          LStrList.Add(Copy(LpCaracter, 1, LReadCnt));
        end;
      end;
      Memo1.Lines.Text := Trim(LStrList.Text);
    finally
      FreeAndNil(LStrList);
      FreeMem(LpCaracter);
    end;
  end;

  //AttachConsoleは2回目の実行でエラーになる
  //そこでFreeConsoleでデアタッチしておく
  FreeConsole;
end;

end.

02_起動中のコマンドプロンプト画面のテキストを取得

コマンドプロンプト画面に表示されているテキストを、別のプログラムで取得するサンプルです。
前項のプログラムはコマンドプロンプトから実行したので、親がコンソールアプリです。親のプロセスにアタッチして操作できましたが、別のプログラムからは、コマンドプロンプトのプロセス ID を取得してアタッチしないと標準出力のハンドルは取得できません。

本サンプルにはコマンドプロンプトを起動する機能はありません。コマンドプロンプトを起動してからテストしてください。

図5
起動中のコマンドプロンプトにアタッチして取得

リスト3
起動中のコマンドプロンプト画面のテキストを、このプログラムで取得

unit GetCmdTextUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function AttachConsole(dwProcess: DWORD): BOOL; stdcall; external 'kernel32.dll';

//=============================================================================
//  コマンドプロンプト画面のテキストバッファの値を取得してTMemoに表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LhCmdWindow : HWND;
  LProcessID  : Cardinal;
  LhStdOutput : THandle;
  LBufferInfo : TConsoleScreenBufferInfo;
  LpCaracter  : PChar;
  LCurCoord   : TCoord;
  LTextLength : Cardinal;
  LReadCnt    : Cardinal;
  LStrList    : TStringList;
  i           : Integer;
begin
  Memo1.Lines.Clear;

  //コマンドプロンプトのウインドウハンドルを取得
  LhCmdWindow := FindWindow('ConsoleWindowClass', nil);
  //スレッドのプロセスIDを取得
  GetWindowThreadProcessId(LhCmdWindow, @LProcessID);

  //コンソールのスレッドにアタッチして標準出力のハンドルを取得
  if AttachConsole(LProcessID) then begin
    LhStdOutput := GetStdHandle(STD_OUTPUT_HANDLE);

    //バッファの情報を取得
    GetConsoleScreenBufferInfo (LhStdOutput, LBufferInfo);

    LTextLength := LBufferInfo.dwSize.X;
    LStrList    := TStringList.Create;

    //メモリの確保(PChar型で受け取る時はメモリの確保が必要)
    GetMem(LpCaracter, LTextLength);
    try
      //バッファの値の読み取り位置
      //X座標は常に左端
      LCurCoord.X := 0;
      //標準出力バッファの内容を1行づつ読み出していく
      for i := 0 to LBufferInfo.dwSize.Y - 1 do begin
        LCurCoord.Y := i;
        if ReadConsoleOutputCharacter(LhStdOutput,
                                      LpCaracter,
                                      LTextLength,
                                      LCurCoord,
                                      LReadCnt) then begin
          //読み出した分だけにしないと後部にゴミが入ることがある
          LStrList.Add(Copy(LpCaracter, 1, LReadCnt));
        end;
      end;
      Memo1.Lines.Text := Trim(LStrList.Text);
    finally
      FreeAndNil(LStrList);
      FreeMem(LpCaracter);
    end;
  end;

  //AttachConsoleは2回目の実行でエラーになる
  //そこでFreeConsoleでデアタッチしておく
  FreeConsole;
end;

end.