コマンドプロンプトをGUIで操作するアプリケーション～Delphiソースコード集

コマンドプロンプトGUIアプリのファイルの準備

本ページの下部のソースコードをコピーして「MamCmdThread.pas」ファイルを作成し、プロジェクトフォルダ内に入れる。

ソースコードの記述

プロジェクトを新規作成（VCLアプリケーション）し、フォーム(Form1)にTEdit、TMenuを配置する。
Edit1のAlignプロパティを「alTop」に設定する。
Menu1のAlignプロパティを「alClient」に設定する。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  MamCmdThread ;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FormResize(Sender: TObject);
  private
    { Private 宣言 }
    cmd:TMamCmdThread;
    procedure OnTextChange({Sender:TObject;}text:String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then
  begin
    Key:=#0;
    cmd.Send(Edit1.Text);
    Edit1.Text:='';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var coordx:integer;
begin
  Memo1.ScrollBars:=ssBoth;
  Memo1.DoubleBuffered:=True;
  Memo1.Font.Name:='ＭＳ ゴシック';
  Memo1.ReadOnly:=True;
  Memo1.Font.Size:=10;
  coordx:=trunc(
    (Memo1.ClientWidth-10) / ((Abs(Memo1.Font.Height)+1))
  )*2-1;
  cmd:=TMamCmdThread.Create(self.Handle,OnTextChange,coordx,9000);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  cmd.Terminate;
  cmd.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
var coordx:integer;
begin
  coordx:=trunc(
    (Memo1.ClientWidth-10) / ((Abs(Memo1.Font.Height)+1))
  )*2-1;
  cmd.SetCoord(coordx,9000);
end;

procedure TForm1.OnTextChange({Sender: TObject;} text: String);
begin
  Memo1.Lines.Text:=text;
  //一番下までスクロールする
  Memo1.Perform(
    EM_LINESCROLL, 0, Memo1.Lines.Count);
  Memo1.SelStart :=length(Memo1.Lines.Text)-1;
end;

end.

実行する

実行ボタンを押して実行します。（デバッグ実行でもOK）
Edit1に「dir」と入力してエンターキーを押すと、GUI上にコマンドプロンプトの実行結果が表示されます。

「MamCmdThread.pas」ファイルのソースコード

unit MamCmdThread;

interface
uses
  Winapi.Windows, Winapi.Messages,Winapi.ShellAPI,
  system.sysutils,system.classes
  ,Vcl.Dialogs,system.strutils;

function GetConsoleWindow: HWnd; stdcall;
  external 'kernel32.dll' name 'GetConsoleWindow';
function AttachConsole(ProcessId: DWORD): BOOL; stdcall;
  external 'kernel32.dll' name 'AttachConsole';

type
  TMamCmdThreadEnc=(
    MamCmdThreadEncSJIS,
    MamCmdThreadEncJIS,
    MamCmdThreadEncEUCJP,
    MamCmdThreadEncUTF8,
    MamCmdThreadEncUTF16
  );

  TMamCmdThreadOnTextChange=procedure(
    {sender:TObject;}text:String) of Object;

  TMamCmdThread=class(TThread)
    private
      fWindowHandle:HWND;
      fcmd:String;
      fShellExecuteInfo:TShellExecuteInfo;
      fBufList:TStringList;
      fOnChangeTextFunc:TMamCmdThreadOnTextChange;
      procedure wProc(var Msg:TMessage);
      function getStdBuf():Boolean;
    protected
      procedure Execute; override;
    public
      constructor Create(
        ParentHandle:HWND;
        OnChangeTextFunc:TMamCmdThreadOnTextChange;
        CoordX:Integer=120;CoordY:Integer=9001;
        Enc: TMamCmdThreadEnc=TMamCmdThreadEnc.MamCmdThreadEncUTF16
      );
      destructor Destroy; override;
      procedure Send(text: String);
      //コードページを設定する
      procedure SetEncoding(Enc:TMamCmdThreadEnc);
      //コンソールのサイスを設定する
      procedure SetCoord(CoordX,CoordY:Integer);
  end;

implementation

uses Unit1;

var fCmdWndHandle:hwnd;

function EnumWindowCallbackFunc(h: HWND; lp: NativeInt): boolean;
var processID:Cardinal;
begin
  GetWindowThreadProcessId(h, processID);
  if lp=processID then
  begin
    fCmdWndHandle:=h;
  end;
  result:=True;
end;


{ TMamCmdThread }

constructor TMamCmdThread.Create(
  ParentHandle:HWND;
  OnChangeTextFunc:TMamCmdThreadOnTextChange;
  CoordX:Integer=120;
  CoordY:Integer=9001;
  Enc: TMamCmdThreadEnc=TMamCmdThreadEnc.MamCmdThreadEncUTF16
);
var ret,pid:Cardinal;
    SRect:_SMALL_RECT;
begin
  inherited Create(False);
  fCmdWndHandle:=0;
  fBufList:=TStringList.Create;
  FreeOnTerminate:=False;

  fOnChangeTextFunc:=OnChangeTextFunc;

  //commandプロンプトの実行フルパスを取得
  fcmd:=GetEnvironmentVariable('COMSPEC');

  fWindowHandle:=ParentHandle;

  ZeroMemory(@fShellExecuteInfo,SizeOf(fShellExecuteInfo));
  fShellExecuteInfo.cbSize:=SizeOf(fShellExecuteInfo);
  //SEE_MASK_NOCLOSEPROCESS プロセスハンドルをクローズしない
  fShellExecuteInfo.fMask:=SEE_MASK_NOCLOSEPROCESS;
  fShellExecuteInfo.lpFile:=PChar(fCmd);
  fShellExecuteInfo.lpVerb:=PChar('');
  fShellExecuteInfo.Wnd:=fWindowHandle;
  //fShellExecuteInfo.nShow:=SW_SHOW;
  fShellExecuteInfo.nShow:=SW_HIDE;

  ShellExecuteEx(@fShellExecuteInfo);
  //成功すると33以上の値になる
  if fShellExecuteInfo.hInstApp>32 then
  begin
    repeat
      //プロセスがアイドル状態になるまで500ms待機する
      ret:=WaitForInputIdle(fShellExecuteInfo.hProcess,500);
    until (ret<>WAIT_TIMEOUT);
    sleep(500);

    //プロセスハンドルからプロセスIDを取得
    pid:=GetProcessId(fShellExecuteInfo.hProcess);
    //プロセスIDからウィンドウハンドルを取得
    EnumWindows(@EnumWindowCallbackFunc, NativeInt(pid));
    //ウィンドウハンドルが取得できなかった場合
    while fCmdWndHandle=0 do
    begin
      fCmdWndHandle := FindWindow(PChar('ConsoleWindowClass'), nil);
      sleep(100);
    end;

    //コンソールのスレッドにアタッチ
    while AttachConsole(pid) do begin end;

    //Ctrl+CとCtrl+Breakを無効にする
    SetConsoleCtrlHandler(nil, true);

    //コンソールウィンドウを小さく設定
    SRect.Left:=0;
    SRect.Top:=0;
    SRect.Right:=1;
    SRect.Bottom:=1;
    SetConsoleWindowInfo(
      GetStdHandle(STD_OUTPUT_HANDLE), True, SRect);
    //コードページ設定
    SetEncoding(Enc);
    //コンソールの幅高さ設定
    SetCoord(CoordX,CoordY);
  end;

end;

destructor TMamCmdThread.Destroy;
//var pid,hPh:Cardinal;
begin
  fOnChangeTextFunc:=nil;
  FreeConsole();
  PostMessage(fCmdWndHandle,WM_CLOSE,0,0);
  fBufList.Free;
  inherited;
end;


procedure TMamCmdThread.Execute;
begin
  inherited;
  while not Terminated do
  begin
    if getStdBuf() then
    begin
      if Assigned(fOnChangeTextFunc) then
        Synchronize(
          procedure
          begin
            fOnChangeTextFunc({nil,}fBufList.Text);
          end
        );
    end;
    sleep(250);
  end;
end;

function TMamCmdThread.getStdBuf:Boolean;
var ret:Boolean;
    Buf:TConsoleScreenBufferInfo;
    pC:PChar;
    y:integer;
    ReadCount:Cardinal;
    st:String;
    BufList:TStringList;
    flag:boolean;
    Cd:TCoord;
begin
  result:=False;
  //バッファの情報を取得(標準エラーから読みだす)
  ret:=GetConsoleScreenBufferInfo(
    GetStdHandle(STD_ERROR_HANDLE),Buf);
  if ret then
  begin
    //メモリの確保
    GetMem(pC, Buf.dwSize.X*2);
    BufList:=TStringList.Create;
    try
      flag:=False;
      for y:=Buf.dwSize.Y-1 downto 0 do
      begin
        zeromemory(pC,Buf.dwSize.X*2);
        Cd.X:=0;
        Cd.Y:=y;
        if ReadConsoleOutputCharacter(
          GetStdHandle(STD_ERROR_HANDLE),
          pC, Buf.dwSize.X, Cd, ReadCount) then
        begin
          st:=String(pC);
          st:=LeftStr(st,ReadCount);
          if trim(st)<>'' then flag:=True;
          if flag then
            BufList.Insert(0,st);
        end;
      end;
      if fBufList.Text<>BufList.Text then
      begin
        fBufList.Text:=BufList.Text;
        result:=True;
      end;
    finally
      FreeMem(pC);
      BufList.Free;
    end;
  end;
end;

procedure TMamCmdThread.Send(text: String);
var InputRecord:TInputRecord;
    NoEW:Cardinal;
    i:Integer;
    ca:array of Char;
begin
  text:=text+Chr(VK_RETURN);
  setlength(ca,length(text));
  strCopy(@ca[0],PChar(text));
  for i:=0  To Length(ca)-1 do
  begin
    ZeroMemory(@InputRecord,sizeof(InputRecord));
    InputRecord.EventType := KEY_EVENT;
    InputRecord.Event.KeyEvent.wRepeatCount:=1;
    InputRecord.Event.KeyEvent.UnicodeChar:=ca[i];
    InputRecord.Event.KeyEvent.bKeyDown:=True;
    WriteConsoleInput(
      GetStdHandle(STD_INPUT_HANDLE),
      InputRecord,1,NoEW
    );
    InputRecord.Event.KeyEvent.bKeyDown:=False;
    WriteConsoleInput(
      GetStdHandle(STD_INPUT_HANDLE),
      InputRecord,1,NoEW
    );
  end;
end;

procedure TMamCmdThread.SetCoord(CoordX, CoordY: Integer);
var cod:TCoord;
begin
  if CoordX<20 then CoordX:=20;
  if CoordY<20 then CoordY:=20;
  if CoordX>32767 then CoordX:=32767;
  if CoordY>50000 then CoordY:=50000;
  cod.X:=CoordX;
  cod.Y:=CoordY;
  SetConsoleScreenBufferSize(
    GetStdHandle(STD_ERROR_HANDLE),cod);
end;

procedure TMamCmdThread.SetEncoding(Enc: TMamCmdThreadEnc);
begin
  if Enc=TMamCmdThreadEnc.MamCmdThreadEncSJIS then
  begin
    SetConsoleCP(932);
    SetConsoleOutputCP(932);
  end
  else if Enc=TMamCmdThreadEnc.MamCmdThreadEncJIS then
  begin
    SetConsoleCP(50220);
    SetConsoleOutputCP(50220);
  end
  else if Enc=TMamCmdThreadEnc.MamCmdThreadEncEUCJP then
  begin
    SetConsoleCP(20932);
    SetConsoleOutputCP(20932);
  end
  else if Enc=TMamCmdThreadEnc.MamCmdThreadEncUTF8 then
  begin
    SetConsoleCP(65001);
    SetConsoleOutputCP(65001);
  end
  else
  begin
    //UTF-16
    SetConsoleCP(1200);
    SetConsoleOutputCP(1200);
  end;
end;

procedure TMamCmdThread.wProc(var Msg: TMessage);
begin

end;

end.

コマンドプロンプトをGUIで操作するアプリケーション ～Delphiソースコード集

コマンドプロンプトGUIアプリのファイルの準備

ソースコードの記述

実行する

「MamCmdThread.pas」ファイルのソースコード

コマンドプロンプトをGUIで操作するアプリケーション～Delphiソースコード集