Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年02月15日] [更新 2019年06月18日]　Delphi サンプルプログラム集
   
520_コンソールアプリケーションを自アプリから操作
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
520_Console2.zip　[3,064 KB]　2019年06月18日版 (EXE 同梱)






01_コンソールアプリケーションを自アプリから操作


本サンプルは，正確な意味のコンソールアプリケーションではありません．
コンソール関係の関数をフォームのボタンクリックでテストするために，Delphi の通常のプロジェクトでコンソール画面も同時に起動するようにしています．このため，コンソール画面とフォームは同一プロセスとして動作しています．したがって，コンソール画面を閉じても，フォームを閉じてもこのプログラムは終了します．



図1
設計時画面


下図が実行結果です．



図2
コンソールで文字列入力
  • ボタンをクリック
  • コンソールで文字列を入力して [Enter]
  • ボタンのキャプションがその文字列に変わる
  • 3 秒経つと元に戻る
図3
コンソールに文字列を出力
  • Writeln を使用した結果
図4
コンソールに文字列を出力
  • Windows API の関数を使用
  • 文字列の表示位置を指定できる

リスト1
プロジェクトのソースコード
コンソール画面も同時に表示するために {$APPTYPE CONSOLE} を追加 
program Project1;

uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}
{$APPTYPE CONSOLE}

begin
  Application.Initialize;
  //Delphi2007以上
  {$IF CompilerVersion > 18.49}
  Application.MainFormOnTaskbar := True;
  {$IFEND}
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


リスト2
コンソールアプリケーション (同一プロセス内で動作) 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
    FConsoleWnd : HWND;
    FhStdout    : THandle;
    FhStdInput  : THandle;
  public
    { Public 宣言 }
  end;
var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  Form作成時の処理
//  コンソールの標準出力，標準入力デバイスのハンドルを取得
//  タイトルを変更
//  コンソール上の[Ctrl]+[C]でアプリが終了しないように設定．
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FConsoleWnd := FindWindow(nil, PChar(Application.ExeName));
  FhStdout    := GetStdHandle(STD_OUTPUT_HANDLE);
  FhStdInput  := GetStdHandle(STD_INPUT_HANDLE);

  SetConsoleTitle('コンソールのテスト');

  SetConsoleCtrlHandler(nil, True);
end;

//=============================================================================
//  ボタンをクリックすると
//  (1)コンソール画面にFocus移動
//  (2)何か文字列をタイプして[Enter]を押すと
//     ボタンのキャプションがその文字列になりFormにFocus移動
//  (3)指定秒後にButton1のCaptionを元に戻す
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LOldCaption : String;
  LStrText    : String;
begin
  LOldCaption := Button1.Caption;

  SetForegroundWindow(FConsoleWnd);
  Write('文字列:');
  Readln(LStrText);
  Button1.Caption := LStrText;

  //このFormを前面に表示
  Self.BringToFront;
  Update;
  Sleep(3000);

  Button1.Caption := LOldCaption;
end;

//=============================================================================
//  コンソールに文字列を出力 Writeln,Write使用
//
//  Writelnは出力後に改行する
//  Writeは改行しない
//  このコードにはReadlnはないので，実行後直ちにこのFormに制御(Focus)が戻る．
//  最後にReadlnを追加するとコンソール画面に入力Focusが移動し，何かをタイプして
//  [Enter]を押下しないと，このFormにFocusが移動しない．
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Writeln('東西');
  Writeln('南北');
  Write('東西');
  Write('南北');
  Writeln;

  //FocusをこのFormに戻しておく
  Show;
end;

//=============================================================================
//  コンソールに文字列を出力 Window APIの関数使用
//  Writelnなどと違いFocusがコンソールに移動しない
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LStrText  : string;
  LStrLen   : DWORD;
  LlpNumber : DWORD;
  LPos      : COORD;
  LScrBuff  : CONSOLE_SCREEN_BUFFER_INFO;
begin
  LStrText := 'Delphi'+Char(13)+Char(10);
  LStrLen  := Length(LStrText);

  //現在のカーソル位置を調査
  GetConsoleScreenBufferInfo(FhStdout, LScrBuff);
  LPos.X := LScrBuff.dwCursorPosition.X;
  LPos.Y := LScrBuff.dwCursorPosition.Y;

  //その1行下から出力
  LPos.X := 0;
  LPos.Y := LPos.Y + 1;

  //白色で文字列を出力
  SetConsoleCursorPosition(FhStdout, LPos);
  SetConsoleTextAttribute(FhStdout, $000F);
  WriteConsole(FhStdout, PChar(LStrText), LStrLen, LlpNumber, nil);

  LPos.X := LPos.X;
  LPos.Y := LPos.Y + 3;

  //明るい緑で文字列を出力
  SetConsoleCursorPosition(FhStdout, LPos);
  SetConsoleTextAttribute(FhStdout, FOREGROUND_GREEN or FOREGROUND_INTENSITY);
  WriteConsole(FhStdout, PChar(LStrText), LStrLen, LlpNumber, nil);

  //文字の色を白に戻しておく
  SetConsoleTextAttribute(FhStdout, $000F);
  FlushConsoleInputBuffer(FhStdInput);
end;

//=============================================================================
//  コンソール画面のクリア
//  バッファサイズ(文字数)を空文字で埋めるだけ(文字の属性値は変更されない)
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LSize     : DWORD;
  LlpNumber : DWORD;
  LPos      : COORD;
  LPosX     : SmallInt;
  LPosY     : SmallInt;
  LScrBuff  : CONSOLE_SCREEN_BUFFER_INFO;
begin
  //スクリーンバッファの行と列サイズを文字単位で取得
  GetConsoleScreenBufferInfo(FhStdout, LScrBuff);

  LPosX := LScrBuff.dwSize.X;
  LPosY := LScrBuff.dwSize.Y;

  //クリア開始位置とサイズ
  LPos.X := 0;
  LPos.Y := 0;
  LSize  := LPosX * LPosY;

  FillConsoleOutputCharacter(FhStdout, Char(' '), LSize, LPos, LlpNumber);
  //開始位置をコンソールの最初に戻しておく
  SetConsoleCursorPosition(FhStdout, LPos);
end;

end.



02_コマンドの実行結果をコンソール画面に出力


TStartupInfo 構造体の標準入力，標準出力先として，現在の標準入力，標準出力のハンドルを指定して CreateProcess 関数でコマンドを実行すれば，コンソールの画面に結果が表示されます．現在有効な標準入力と標準出力のハンドルは，GetStdHandle 関数で取得できます．
結果は，現在のカーソル位置から表示されます．

本サンプルは，最初のサンプルと同じで，プロジェクトのソースコードに {$APPTYPE CONSOLE} を追加 して，本アプリの EXE とコンソール画面を同時に起動しています．



図5
cmd.exe の dir コマンドの実行結果

リスト3
CreateProcess 関数で実行したコマンドの実行結果をコンソール画面に表示する		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

//=============================================================================
//  コマンドの実行結果をコンソールに出力するサンプル
//  CreateProcessを使用する方法
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCommandLine : string;
  LStartupInfo : TStartupInfo;
  LProcessInfo : TProcessInformation;
begin
  Screen.Cursor := crHourGlass;

  //CreateProcessの引数の構造体のメンバを設定
  //入出力を標準入出力に設定する
  ZeroMemory(@LStartupInfo, SizeOf(TStartupInfo));
  ZeroMemory(@LProcessInfo, SizeOf(TProcessInformation));
  LStartupInfo.cb          := SizeOf(TStartupInfo);
  LStartupInfo.hStdInput   := GetStdHandle(STD_INPUT_HANDLE);
  LStartupInfo.hStdOutput  := GetStdHandle(STD_OUTPUT_HANDLE);
  LStartupInfo.hStdError   := GetStdHandle(STD_ERROR_HANDLE);
  LStartupInfo.dwFlags     := STARTF_USESTDHANDLES;

  //コマンド実行
  try
    LCommandLine := Trim(Edit1.Text);
    UniqueString(LCommandLine);
    if not CreateProcess(nil,
                         PChar(LCommandLine),
                         nil,
                         nil,
                         True,
                         0,
                         nil,
                         nil,
                         LStartupInfo,
                         LProcessInfo) then begin
      //CreateProcess失敗
    end;
  finally
    CloseHandle(LProcessInfo.hProcess);
    CloseHandle(LProcessInfo.hThread);
  end;

  Screen.Cursor := crDefault;
end;

end.



03_コンソール画面の起動


ここまでのサンプルは，EXE 起動と同時にコンソール画面を起動しています．
本サンプルでは，実行時に自アプリからコンソール画面を起動して表示します．

コマンドプロンプトの起動は，ShellExecute, ShellExecuteEx, CreateProcess 関数等を使用しますが，コンソール画面の起動には AllocConsole 関数を使用します．AllocConsole 関数でコンソールを起動すれば，コンソール関係の関数類を使用して，コンソール関係の操作が可能になります．



図6
実行画面

リスト4
AllocConsole 関数でコンソール画面を起動		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    FIsRunConsole : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeConsole;
  FIsRunConsole := False;
end;

//=============================================================================
//  コンソール画面を起動
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LhStdout : THandle;
  LColor   : Word;
begin
  FIsRunConsole := AllocConsole;
  if not FIsRunConsole then exit;

  SetConsoleTitle('Console Test');

  //標準出力のハンドルを取得
  LhStdout := GetStdHandle(STD_OUTPUT_HANDLE);

  //文字の色を明るい白にする
  LColor := FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED or 8;
  SetConsoleTextAttribute(LhStdout, LColor);


  Writeln('コンソール画面の起動テスト');
end;

//=============================================================================
//  コンソール画面を閉じる
//  入力待ちになっている時は閉じることができない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  FormDestroy(nil);
end;

end.



04_コンソール画面をデバッグの時だけ起動


デバッグの時 (IDE 上でコンパイルして実行の時) だけコンソール仮面を起動したい場合は，アプリの起動時にコンソール画面を表示するようにします．以下のように，プロジェクトのソースコードにコンソール画面を起動するコードを記述します．



リスト5
デバッグの時だけコンソール画面をアプリの起動時に表示		 
program Project1;

uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  // FIsDebug はクラスのメンバではないグローバル変数
  if DebugHook <> 0 then begin
    FIsDebug := True;
    AllocConsole;
  end;

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


上のコードではデバッグ時だけコンソール画面を表示するようにしています．必要な時に，EXE を直接実行する時でもコンソール画面を表示したい場合，例えば次のように，キー押下を検出する方法が考えられます．
このコードでは，[Shift] キーと [Ctrl] キーを押した状態で EXE を起動すると，コンソール画面も同時に起動します．

このコードでは [Ctrl] + [C} と [Ctrl] + [Break] の操作でコンソール画面を閉じないようにしています．また，[最小化] と [最大化] のボタンを非表示にして，更に [閉じる] ボタンでコンソール画面を閉じることができはないようにしています．



図7
デバッグの時だけコンソール画面を起動

リスト6
必要な時に，EXE を直接実行した時もコンソール画面を表示する 1 つの方法		 
program Project1;

uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

function GetConsoleWindow: HWND; stdcall; external  kernel32;

//----------------------------------------------------------------------------
//  SetConsoleCtrlHandler 関数のコールバック関数
//
//  戻り値が True の時
//  OS は何もしない
//
//  戻り値が False の時
//  イベントは OS が処理する
//  ex. [CTRL] + [C] 押下でアプリケーション終了
//  ex. [CTRL] + [BREAK] 押下でアプリケーション終了
//----------------------------------------------------------------------------
function HandlerRoutine(dwCtrlType: DWORD): BOOL; stdcall;
begin
  Result := True;
end;

var
  LKeyFlag  : Boolean;
  LhConsole : HWND;
  LOldStyle : Cardinal;
  LNewStyle : Cardinal;
  LhSysmenu : hMenu;

begin
  LKeyFlag := ((GetKeyState(VK_SHIFT) and $8000) <> 0)
          and ((GetKeyState(VK_CONTROL) and $8000) <> 0);
  // FIsDebug はクラスのメンバではないグローバル変数
  if (DebugHook <> 0) or LKeyFlag then begin
    FIsDebug := True;
    AllocConsole;

    // イベントハンドラルーチンの設定
    SetConsoleCtrlHandler(@HandlerRoutine, True);

    // コンソールのウィンドウハンドルを取得
    LhConsole:= GetConsoleWindow;

    // [最小化] [最大化] ボタンを非表示にする
    LOldStyle := GetWindowLong(LHConsole, GWL_STYLE);
    LNewStyle := LOldStyle and not WS_MINIMIZEBOX and not WS_MAXIMIZEBOX;
    SetWindowLong(LhConsole, GWL_STYLE, LNewStyle);

    // メニューのハンドルを取得
    LhSysmenu := GetSystemMenu(LHConsole, False);
    // [閉じる] の機能を無効化
    // 終了はあくまでもコンソールを起動したアプリ側で実行
    DeleteMenu(LhSysMenu, SC_CLOSE, MF_BYCOMMAND);
  end;

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


リスト7
コンソール画面の操作用コード例		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;
  FIsDebug : Boolean;

implementation

{$R *.dfm}

  function GetConsoleWindow: HWND; stdcall; external  kernel32;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeConsole;
end;

//=============================================================================
//  コンソール画面の操作
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LhStdout : THandle;
  LColor   : Word;
begin
  if FIsDebug then begin
    SetConsoleTitle('Console Test');

    //標準出力のハンドルを取得
    LhStdout := GetStdHandle(STD_OUTPUT_HANDLE);

    //文字の色を明るい白にする
    LColor := FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED or 8;
    SetConsoleTextAttribute(LhStdout, LColor);


    Writeln('デバック時だけコンソール画面を起動');
  end;
end;

//=============================================================================
//  コンソール画面の表示・非表示のトグル操作
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LhConsole : HWND;
begin
  if FIsDebug then begin
    // コンソールのウィンドウハンドルを取得
    LhConsole:= GetConsoleWindow;

    if IsWindowVisible(LhConsole) then begin
      ShowWindow(LhConsole, SW_HIDE);
    end else begin
      ShowWindow(LhConsole, SW_SHOW);
    end;
  end;
end;

end.



05_起動中のコンソールアプリケーションを操作


ここまでのサンプルは，EXE 起動と同時にコンソール画面を起動，あるいは実行時にコンソール画面を起動する例です．本サンプルは，既に起動しているコンソールアプリを操作する例です．

コンソールアプリケーシヨンは，コマンドプロンプト (コマンドプロセッサ) 上で動作するアプリケーションです．以下の参考リンクのサンプルプログラムと同じように，AttachConsole 関数でコンソールアプリのスレッドにアタッチすることで操作可能になります．
本サンプルは，コンソールウィンドウのタイトル (キャプション) を変更して，文字の色を変更するだけの単純な操作例です．


図8
起動中のコンソールアプリにアタッチして操作

リスト8
既に起動していいるコンソールアプリを操作する例		 
unit Unit1;

interface

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

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

implementation

{$R *.DFM}

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

//=============================================================================
//  起動中のコンソール画面に対する操作
//  起動中のコンソール画面には AttachConsole でアタッチする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LhConsoleWnd : HWND;
  LProcessID   : Cardinal;
  LhStdout     : THandle;
  LColor       : Word;
begin
  // コンソール画面のウインドウハンドルを取得
  LhConsoleWnd := FindWindow('ConsoleWindowClass', nil);
  // スレッドのプロセスIDを取得
  GetWindowThreadProcessId(LhConsoleWnd, @LProcessID);

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

    SetConsoleTitle('コンソールのテスト');
    Writeln('文字の色を変更');

    // 文字の色を，緑と赤で黄色にする
    LColor := FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY;
    SetConsoleTextAttribute(LhStdout, LColor);

    // FreeConsoleでデアタッチしておく
    FreeConsole;
  end;
end;

//=============================================================================
//  起動中のコンソール画面を閉じる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LhConsoleWnd : HWND;
begin
  // コンソール画面のウインドウハンドルを取得
  LhConsoleWnd := FindWindow('ConsoleWindowClass', nil);
  if LhConsoleWnd <> 0 then begin
    PostMessage(LhConsoleWnd, WM_CLOSE, 0, 0);
  end;
end;

end.


リスト9
操作対象のコンソールアプリの例		 
{$APPTYPE CONSOLE}
program consoleApp;

uses
  Forms,
  Windows,
  SysUtils;

function GetConsoleWindow: HWND; stdcall; external  kernel32;

var
  LhConsole : HWND;
  LOldStyle : Cardinal;
  LNewStyle : Cardinal;
  LResult   : string;
begin
  // [Ctrl] + [C] で閉じないようにする
  SetConsoleCtrlHandler(nil, True);

  // ウィンドウハンドルを取得
  LhConsole := GetConsoleWindow;

  // [最小化] [最大化] ボタンを非表示にする
  LOldStyle := GetWindowLong(LhConsole, GWL_STYLE);
  LNewStyle := LOldStyle and not WS_MINIMIZEBOX and not WS_MAXIMIZEBOX;
  SetWindowLong(LhConsole, GWL_STYLE, LNewStyle);

  while True do begin
    Readln(LResult);
    if UpperCase(LResult) = 'EXIT' then Exit;
  end;
end.


ウィンドウの閉じるボタン [X] は，次のコードで無効化できます．ウィンドウの閉じるボタンは非表示にできません．

 

  // ウィンドウのシステムメニューのハンドルを取得
  // LhSysmenu は HMENU 型の変数
  LhSysmenu := GetSystemMenu(LhConsole, False);
  // 閉じるメニューを無効化
  DeleteMenu(LhSysMenu, SC_CLOSE, MF_BYCOMMAND);