Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2008年01月13日] [更新 2016年10月19日] Delphi サンプルプログラム集
   
000_コマンドラインコンパイラの実行
動作確認等 [01] - [05] Windows 7 U64(SP1) + Delphi XE(UP1) Pro
[06] - [07] Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32, VCL-64
000_CommandLineCompile.zip [3,123 KB] 2016年10月19日版(EXE同梱)



  • 2010年03月15日
  • より実用的なアプリケーションにし,仕様変更したのでフォルダ名とプログラム名を変更.
    変更内容は記事本文参照.
  • 2010年03月17日
  • CommandLineUnit.pas の修正.参照カウンタの問題に対応.
  • 2010年03月20日
  • サンプルの [04] を追加.
  • 2010年03月30日
  • パスをドラッグ・アンド・ドラッグで追加可能にした
  • 追加パスの重複チェック機能追加
  • 2010年04月25日
  • ファイルのドラッグ・アンド・ドロップでの文字数指定の間違いを修正
  • 2011年02月16日
  • Delphi XE 対応コード追加
  • 2012年01月15日
  • Delphi XE2 対応コード追加
  • 既にアンインストールした Delphi の情報もタブに追加してしまう現象を修正
  • [04_バイナリ形式フォームをテキスト形式に変換] を削除して,ユニットスコープのアプリを追加
  • 2012年01月22日
  • Delphi XE2 対応のユニットスコープのコードの挿入位置が間違っていたのを修正 (ライブラリパスの設定が無効になってしまった)
  • 2013年02月05日
  • Delphi XE3 対応コードを追加
  • Windows Vista 以降でのファイルのドラッグ・アンド・ドロップ対応コードを追加
  • [04_ドラッグ・アンド・ドロップ機能の実装 ( Vista 以降への対応 )] を追加
  • 2013年03月08日
  • アプリケーションマニフェストを追加
  • ヒントと警告メッセージ出力の制御を修正
  • フォルダの選択に TFileOpenDialog を使用するコードに変更
  • [05] [06] [07] を追加
  • 2013年12月30日
  • Delphi XE4, XE5 対応コードを追加
  • 2015年01月11日
  • Delphi XE6, XE7 対応コードを追加




コマンドラインコンパイラの実行


このアプリケーションは,当サイトで提供しているサンプルプログラムが,Delphi のどのバージョンでコンパイル可能かを,IDE を起動せずに確認するために作成したものです,
以下の様な仕様となっています.
  • 起動すると,現在のシステムにインストールされている Delphi のバージョンを検出して,該当するバージョン分の (タブコントロールの) タブを作成
  • 初回起動時には,各 Delphi のバージョンのライブラリパスも自動検出して設定.このライブラリパスは [追加] [削除] 可能.設定内容はこのアプリだけで有効
  • [フォルダ指定] ボタンでフォルダを指定すると,そのフォルダ内のサブフォルダ内も含めてプロジェクト全てをコンパイル開始
  • フォルダまたはプロジェクトファイル (拡張子はdpr) のドラッグ・アンド・ドロップでのコンパイルも可能
  • コンパイル済みのリソースファイル (.res 等) のないプロジェクトはコンパイルできない
  • インクルードファイルは,インクルードが必要なファイルと同じフォルダにないとインクルードしない
  • Delphi XE2 以降では,ユニットスコープ名がないとコンパイル不可の場合がある

また,コンパイルができても,作成した EXE が正常に動作するとは限りません.
コマンドラインコンパイラは CreateProcess 関数で非表示起動します.実行結果の EXE はもちろん出力しますが,コンパイルのエラー等の一部も TMemo コンポーネントに出力するようにしています.これにはパイプという機能を利用していますが,このコードには,[552_コマンドラインのリダイレクト] で作成したユニットを使用しています.

インストールされている Delphi のバージョンを自動的に検出したいのですが,Delphi の供給元が何回か変更になっているのが原因と思われますが,レジストリのインストール情報のキー項目が異なっているため断念しました.



[備考]
本ページのサンプルでは,コマンドラインコンパイラとして,dcc32.exe または dcc64.exe を使用しています.dcc32.exe も dcc64.exe も .dpr, dproj どちらのプロジェクトファイルでもコンパイルできますが,本ページのサンプルでは .dpr だけを使用する仕様になっています.
MSBuild を使用してコンパイルする場合は,プロジェクトファイルとして .dproj を使用します..dpr ではコンパイルできません.





01_フォルダ内の全てのプロジェクトをコンパイル


[フォルダ指定] ボタンをクリックして,フォルダを指定すると,そのフォルダ内のプロジェクト全てをコンパイルします.ただし,リソースファイル (拡張子は res) がないプロジェクトはコンパイルできません.また,Delphi XE2 以降ではユニットスコープが指定されていないプロジェクトではコンパイルに失敗する場合があります.
手順は以下の図の説明を参考にしてください.プロジェクトファイルのドラッグ・アンド・ドロップにも対応しています (DragQueryFile 関数使用).

このプログラムを,Windows Vista 以降で実行する場合は,管理者権限 [管理者として実行] する必要があります.そこで,アプリケーションマニフェストを使用しています.EXE 起動時に,下図のよう管理者への昇格確認のダイアログが表示されます.




図1
管理者権限で実行

  • 図2
  • 設計時画面

  • 図3
  • 指定したフォルダ内 (サブフォルダ内も全て含む) を Delphi XE でコンパイル中
  • タブを切り替えると,別バージョンの Delphi でのコンパイルとなる
  • リソースファイルがないプロジェクトは,コンパイル不可

  • 図4
  • 必要であればライブラリパスを追加
  • Delphi の IDE で設定したパスも追加可能
  • プロジェクトフォルダの 1 つ上のフォルダは,実行時に自動で検索パスに追加される
  • この設定は本アプリのみで有効で,Delphi のバージョンごとに設定を保存
  • 実際にパスが存在するかのチェック機能はない

リスト1
指定フォルダ内の全プロジェクトをコンパイル
リソースファイルがないプロジェクトは,コンパイル不可
unit CommandLineCompileUnit;

interface

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

type
  TForm1 = class(TForm)
    TabControl1: TTabControl;
    Panel1: TPanel;
    btnFolder: TButton;
    btnCancel: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    btnEditLibPath: TButton;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    Memo1: TMemo;
    Panel3: TPanel;
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    OpenDialog1: TOpenDialog;
    ApplicationEvents1: TApplicationEvents;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnEditLibPathClick(Sender: TObject);
    procedure btnFolderClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private 宣言 }
    CancelFlag : Boolean;
    procedure GetdprFilesListAll(APath: String; FileList:TStringList);
    function CreateCommandLineStr(dccPath: String; ProjName: String): String;
    procedure ControlsEnabled(WC: TWinControl; Flag : Boolean);
    function ComplieProject(dccPath: String; FileList: TStringList): Integer;
  public
    { Public 宣言 }
    IniFileName : String;
    procedure SetDefaultLibPath(TabName, ConfigFileName: String; SL: TStringList);
  end;

var
  Form1: TForm1;

implementation

uses
  EditLibraryPath, IniFiles, Registry, FileCtrl, Types, IOUtils,
  plCommandRedirect, ShlObj, ShellAPI, StrUtils;

//ChangeWindowMessageFilter関数用の定数
const
  //  Microsoft Windows SDK 7.1 より抜粋
  //  WM_COPYGLOBALDATAは非公開メッセージ
  //  * Message Filter
  //  #define MSGFLT_ADD 1
  //  #define MSGFLT_REMOVE 2
  MSGFLT_ADD        = 1;
  MSGFLT_REMOVE     = 2;
  WM_COPYGLOBALDATA = $0049;

{$R *.dfm}

//=============================================================================
//  初期化処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);

  //---------------------------------------------------------------------------
  //  レジストリからDelphiの起動フルパスを取得してIniファイルに保存
  //  64bit版では,本当はdcc32exePathという名前は変なのであるがそのまま使用
  //---------------------------------------------------------------------------
  procedure ReadRegistValue(ConfigIniFile: TIniFile; Reg: TRegistry;
    AppKey, AppItem, AppKeyLib, TabName, ExeName: String);
  var
    dcc32exePath : String;
  begin
    if Reg.OpenKey(AppKey, False) then begin
      try
        dcc32exePath := ExtractFilePath(Reg.ReadString(AppItem));

        if dcc32exePath <> '' then begin
          dcc32exePath := dcc32exePath + ExeName;
          TabControl1.Tabs.Add(TabName);
          ConfigIniFile.WriteString(TabName, 'dcc32exePath', dcc32exePath);
          ConfigIniFile.WriteString(TabName, 'AppKeyLib', AppKeyLib);
        end;
      finally
        Reg.CloseKey;
      end;
    end;
  end;
  //---------------------------------------------------------------------------

var
  DLLHandle   : THandle;
  FuncFilter  : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
  IniFile     : TIniFile;
  ATabName    : String;
  AFormTop    : Integer;
  AFormLeft   : Integer;
  AFormWidth  : Integer;
  AFormHeight : Integer;
  AIndex      : Integer;
  Reg         : TRegistry;
  AppKey      : String;
  AppItem     : String;
  AppKeyLib   : String;
begin
  //---------------------------------------------------------------------------
  //  ユーザーインターフェイス特権の分離 (UIPI)対策
  //  低い権限で実行したアプリ(エクスプローラ等)からのドラッグ&ドロップを受付
  //  Windows Vista以降用
  //  関数ChangeWindowMessageFilterは,Windows XP以前にはないのでGetProcAddress
  //  で確認する必要がある
  //---------------------------------------------------------------------------
  if CheckWin32Version(6, 0) then begin
    DLLHandle := loadLibrary('user32.dll');
    try
      if DLLHandle > 0 then begin
        @FuncFilter := GetProcAddress(DLLHandle, 'ChangeWindowMessageFilter');
        if @FuncFilter <> nil then begin
          FuncFilter(WM_DROPFILES,      MSGFLT_ADD);
          FuncFilter(WM_COPYDATA,       MSGFLT_ADD);
          FuncFilter(WM_COPYGLOBALDATA, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;


  btnCancel.Enabled    := False;

  Label1.Caption       := '';
  ProgressBar1.Visible := False;
  Memo1.ReadOnly       := True;
  Memo1.Lines.Clear;


  IniFileName   := ChangeFileExt(Application.ExeName, '.ini');
  IniFile := TIniFile.Create(IniFileName);

  ATabName    := '';
  AFormTop    := 0;
  AFormLeft   := 0;
  AFormWidth  := 0;
  AFormHeight := 0;

  try
    if FileExists(IniFileName) then begin
      ATabName    := IniFile.ReadString ('Common', 'TabName',   '');
      AFormTop    := IniFile.ReadInteger('Common', 'FormTop',    0);
      AFormLeft   := IniFile.ReadInteger('Common', 'FormLeft',   0);
      AFormWidth  := IniFile.ReadInteger('Common', 'FormWidth',  0);
      AFormHeight := IniFile.ReadInteger('Common', 'FormHeight', 0);
    end;
  finally
    FreeAndNil(IniFile);
  end;


  if (AFormTop * AFormLeft * AFormWidth * AFormHeight) = 0 then begin
    Self.Position := poDesktopCenter;
  end else begin
    Self.Position := poDesigned;
  end;
  if AFormTop    > 0 then Self.Top    := AFormTop;
  if AFormLeft   > 0 then Self.Left   := AFormLeft;
  if AFormWidth  > 0 then Self.Width  := AFormWidth;
  if AFormHeight > 0 then Self.Height := AFormHeight;

  //レジストリからDelphiのディレクトリを取得してタブコントロールのタブを作成
  //Program Filesから取得するとインストール先を変更している場合に取得不可
  //さすがにレジストリまで操作する人はいないであろう
  if TabControl1.Tabs.Count = 0 then begin
    Reg         := TRegistry.Create;
    Reg.Access  := KEY_READ;
    Reg.RootKey := HKEY_LOCAL_MACHINE;

    IniFile := TIniFile.Create(IniFileName);

    //AppKeyLibはライブラリパスが格納されている場所のKEY値
    //ルートキーのHKEY_CURRENT_USERのこのKEYのSearch Pathにライブラリパスがある
    //IniファイルにはこのKEY値だけ保存しておき,必要な時にここから読み出す
    try
      TabControl1.TabHeight := 23;
      TabControl1.TabWidth  := 90;

      //Delphi 4
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Delphi\4.0
      AppKey    := 'SOFTWARE\Borland\Delphi\4.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'Delphi 4';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 4', 'dcc32.exe');

      //Delphi 5
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Delphi\5.0
      AppKey    := 'SOFTWARE\Borland\Delphi\5.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 5', 'dcc32.exe');

      //Delphi 6
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Delphi\6.0
      AppKey    := 'SOFTWARE\Borland\Delphi\6.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 6', 'dcc32.exe');

      //Delphi 7
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Delphi\7.0
      AppKey    := 'SOFTWARE\Borland\Delphi\7.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 7', 'dcc32.exe');

      //Delphi 2005
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Borland\BDS\3.0
      AppKey    := 'SOFTWARE\Borland\BDS\3.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 2005', 'dcc32.exe');

      //Delphi 2006
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Borland\BDS\4.0
      AppKey    := 'SOFTWARE\Borland\BDS\4.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 2006', 'dcc32.exe');

      //Delphi 2007
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Borland\BDS\5.0
      AppKey    := 'SOFTWARE\Borland\BDS\5.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 2007', 'dcc32.exe');

      //Delphi 2009
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\CodeGear\BDS\6.0
      AppKey    := 'SOFTWARE\CodeGear\BDS\6.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 2009', 'dcc32.exe');

      //Delphi 2010
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\CodeGear\BDS\7.0
      AppKey    := 'SOFTWARE\CodeGear\BDS\7.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi 2010', 'dcc32.exe');

      //Delphi XE
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\8.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\8.0';
      AppKeyLib := AppKey + '\Library';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE', 'dcc32.exe');

      //Delphi XE2 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\9.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\9.0';
      AppKeyLib := AppKey + '\Library\Win32';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE2 32', 'dcc32.exe');

      //Delphi XE2 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\9.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\9.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE2 64', 'dcc64.exe');

      //Delphi XE3 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\10.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\10.0';
      AppKeyLib := AppKey + '\Library\Win32';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE3 32', 'dcc32.exe');

      //Delphi XE3 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\10.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\10.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE3 64', 'dcc64.exe');

      //Delphi XE4 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\11.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\11.0';
      AppKeyLib := AppKey + '\Library\Win32';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE4 32', 'dcc32.exe');

      //Delphi XE4 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\11.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\11.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE4 64', 'dcc64.exe');

      //Delphi XE5 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\12.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\12.0';
      AppKeyLib := AppKey + '\Library\Win32';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE5 32', 'dcc32.exe');

      //Delphi XE5 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\12.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\12.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE5 64', 'dcc64.exe');

      //Delphi XE6 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\14.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\14.0';
      AppKeyLib := AppKey + '\Library\Win32';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE6 32', 'dcc32.exe');

      //Delphi XE6 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\14.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\14.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE6 64', 'dcc64.exe');

      //Delphi XE7 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\15.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\15.0';
      AppKeyLib := AppKey + '\Library\Win32';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE7 32', 'dcc32.exe');

      //Delphi XE7 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\15.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\15.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE7 64', 'dcc64.exe');

      //Delphi XE8 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\16.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\16.0';
      AppKeyLib := AppKey + '\Library\Win32';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE8 32', 'dcc32.exe');

      //Delphi XE8 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\16.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\16.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'Delphi XE8 64', 'dcc64.exe');

      //-----------------------------------------------------------------------
      //  Delphi 10(DX) Seattle は試用版での動作確認
      //  おそらく以下の設定で動作するハズである
      //  試用版では以下のメッセージが表示されコンパイルできない
      //  試用版はコマンドラインコンパイラは使用不可
      //  This version of the product does not support command line compiling.
      //-----------------------------------------------------------------------

      //Delphi 10 Seattle 32
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\17.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\17.0';
      AppKeyLib := AppKey + '\Library\Win32';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'DX Seattle 32', 'dcc32.exe');

      //Delphi Seattle 64
      //キー HKEY_LOCAL_MACHINE\SOFTWARE\Embarcadero\BDS\17.0
      AppKey    := 'SOFTWARE\Embarcadero\BDS\17.0';
      AppKeyLib := AppKey + '\Library\Win64';
      AppItem   := 'App';
      ReadRegistValue(IniFile, Reg, AppKey, AppItem,
                      AppKeyLib, 'DX Seattle 64', 'dcc64.exe');

      //-----------------------------------------------------------------------
      //  Delphiの新しいバージョン用の処理は,この下に追加する
      //  コードは,上のコードを参考にして作成する
      //  もしかしたら,CreateCommandLineStrルーチンの,コマンドラインの設定を
      //  追加あるいは変更する必要があるかも知れない
      //-----------------------------------------------------------------------

    finally
      FreeAndNil(IniFile);
      FreeAndNil(Reg);
    end;
  end;

  if TabControl1.Tabs.Count = 0 then begin
    ControlsEnabled(Panel1, False);
  end else begin
    AIndex := TabControl1.Tabs.IndexOf(ATabName);
    if AIndex < 0 then AIndex := 0;
    TabControl1.TabIndex := AIndex;
    TabControl1Change(nil);

    //ドラッグアンドドロップを許可
    //usesにShellAPIが必要
    DragAcceptFiles(Memo1.Handle, True);
    DragAcceptFiles(Panel1.Handle, True);
  end;
end;

//=============================================================================
//  フォームを閉じる時は,フォームの位置とサイズをiniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  ConfigIniFile : TIniFile;
  ATabName      : String;
begin
  ConfigIniFile := TIniFile.Create(IniFileName);
  if TabControl1.Tabs.Count = 0 then begin
    ATabName := '';
  end else begin
    ATabName := TabControl1.Tabs[TabControl1.TabIndex];
  end;

  try
    ConfigIniFile.WriteString ('Common', 'TabName',    ATabName);
    ConfigIniFile.WriteInteger('Common', 'FormTop',    Self.Top);
    ConfigIniFile.WriteInteger('Common', 'FormLeft',   Self.Left);
    ConfigIniFile.WriteInteger('Common', 'FormWidth',  Self.Width);
    ConfigIniFile.WriteInteger('Common', 'FormHeight', Self.Height);
  finally
    FreeAndNil(ConfigIniFile);
  end;
end;

//=============================================================================
//  [パス編集]
//  コンパイルに使用するライブラリのパスの編集
//  ここで設定しない場合は,$(DELPHI)Libまたは$(BDS)のdcc32.cfgの設定のみを使
//  用することになる
//=============================================================================
procedure TForm1.btnEditLibPathClick(Sender: TObject);
begin
  Form2 := TForm2.Create(Self);
  try
    Form2.ShowModal;
    Update;
  finally
    FreeAndNil(Form2);
  end;
end;

//=============================================================================
//  [フォルダ指定]
//  フォルダを選択してコンパイル開始
//  コマンドラインの実行には,サンプルプログラム集の[552_コマンドラインのリダイ
//  レクト]で作成したユニットCommandLineUnitを使用
//
//  選択したフォルダ内のdprファイルを検索してコンパイルする
//  コンパイルのオプションはCreateCommandLineStrメソッドで作成
//  リソース(.res)がないプロジェクトはコンパイルできない
//=============================================================================
procedure TForm1.btnFolderClick(Sender: TObject);
var
  FileDlg       : TFileOpenDialog;
  ConfigIniFile : TIniFile;
  TabName       : String;
  BasePath      : String;
  dcc32exePath  : String;
  FileList      : TStringList;
begin
  ConfigIniFile := TIniFile.Create(IniFileName);
  TabName := TabControl1.Tabs[TabControl1.TabIndex];

  //前回終了時のフォルダを初期フォルダに
  BasePath     := '';
  dcc32exePath := '';

  try
    if FileExists(IniFileName) then begin
      BasePath     := ConfigIniFile.ReadString('Common', 'BasePath', '');
      if ConfigIniFile.SectionExists(TabName) then begin
        dcc32exePath := ConfigIniFile.ReadString(TabName, 'dcc32exePath', '');
      end;
    end;

    if BasePath = '' then begin
      BasePath := ExtractFileDir(Application.ExeName);
    end;

    if not FileExists(dcc32exePath) then begin
      ShowMessage('コマンドラインコンパイラが見つかりません.');
    end else begin
      //Windows Vista以上の場合
      if CheckWin32Version(6, 0) then begin
        FileDlg := TFileOpenDialog.Create(Self);
        try
          FileDlg.Options := [fdoPickFolders, fdoForceFileSystem];
          FileDlg.DefaultFolder := BasePath;
          FileDlg.FileName      := BasePath;
          if FileDlg.Execute then begin
            Update;
            BasePath := FileDlg.FileName;

            FileList := TStringList.Create;
            try
              GetdprFilesListAll(IncludeTrailingPathDelimiter(BasePath), FileList);
              ComplieProject(dcc32exePath, FileList)
            finally
              FreeAndNil(FileList);
            end;
          end;
        finally
          FreeAndNil(FileDlg);
        end;
      end else begin
        if FileCtrl.SelectDirectory('対象フォルダ指定',  '', BasePath) then begin
          ConfigIniFile.WriteString('Common', 'BasePath', BasePath);

          FileList := TStringList.Create;
          try
            GetdprFilesListAll(IncludeTrailingPathDelimiter(BasePath), FileList);
            ComplieProject(dcc32exePath, FileList)
          finally
            FreeAndNil(FileList);
          end;
        end;
      end;
    end;
    ConfigIniFile.WriteString('Common', 'BasePath', BasePath);
  finally
    FreeAndNil(ConfigIniFile);
  end;
end;

//=============================================================================
//  エクスプローラからのファイルのドラッグ・ドロップ処理
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  i              : Integer;
  ACount         : Integer;
  Buf            : array [0..MAX_PATH-1] of Char;
  APath          : String;
  ConfigIniFile  : TIniFile;
  TabName        : String;
  dcc32exePath   : String;
  FileList       : TStringList;
  CmdLineExeName : WideString;
  ACmdLine       : TplCommandRedirect;
  ExeFileCount   : Integer;
  CheckFlag      : Boolean;
begin
  CmdLineExeName := '';

  if Msg.message =WM_DROPFILES then begin
    CheckFlag := CheckBox1.Checked;

    if (FindDragTarget(Msg.pt, False) = Memo1) or
       (FindDragTarget(Msg.pt, False) = Panel1) then begin

      FileList := TStringList.Create;
      FileList.Sorted := True;
      Memo1.Clear;
      Memo1.Update;
      try
        try
          ACount       := DragQueryFile(Msg.wParam, High(DWORD), nil, 0);
          ExeFileCount := 0;
          for i := 0 to ACount -1 do begin
            DragQueryFile(Msg.WParam, i, Buf, MAX_PATH);
            APath := Buf;
            if UpperCase(ExtractFileExt(APath)) = '.DPR' then begin
              //dprのドラッグアンドドロップの時はEXEがあってもコンパイルする
              CheckBox1.Checked := False;
              FileList.Add(APath);
            end else
            if UpperCase(ExtractFileExt(APath)) = '.EXE' then begin
              //CreataeProcessのStartupInfoのdwFlagsにSTARTF_USESHOWWINDOWを指定
              //しているのでcmd.exeが必要
              //コンソールアプリでは不要だが一般の表示を伴うアプリでは非表示の
              //ままとなってしまう
              CmdLineExeName := 'cmd.exe /c ' + APath;
              inc(ExeFileCount);
            end else
            if SysUtils.DirectoryExists(APath) then begin
              GetdprFilesListAll(IncludeTrailingPathDelimiter(APath), FileList);
            end;
          end;
        finally
          //ドロップが完了したことを伝える
          DragFinish(msg.WParam);
        end;

        if CmdLineExeName <> '' then begin
          if ExeFileCount > 1 then begin
            ShowMessage('EXEファイルは1つしか実行できません.');
          end else begin
            Screen.Cursor := crHourGlass;
            ACmdLine      := TplCommandRedirect.Create;
            try
              Memo1.Text := ACmdLine.GrabStdOutText(CmdLineExeName);
            finally
              ACmdLine.Free;
              Screen.Cursor := crDefault;
            end;
          end;
        end else begin;
          ConfigIniFile := TIniFile.Create(IniFileName);
          TabName := TabControl1.Tabs[TabControl1.TabIndex];

          dcc32exePath := '';
          try
            if FileExists(IniFileName) then begin
              if ConfigIniFile.SectionExists(TabName) then begin
                dcc32exePath := ConfigIniFile.ReadString(TabName,'dcc32exePath','');
              end;
            end;

            if not FileExists(dcc32exePath) then begin
              ShowMessage('コマンドラインコンパイラが見つかりません.');
            end else begin
              ComplieProject(dcc32exePath, FileList)
            end;
          finally
            FreeAndNil(ConfigIniFile);
          end;
        end;
      finally
        FreeAndNil(FileList);
      end;
    end;
    CheckBox1.Checked := CheckFlag;
  end;
end;

//=============================================================================
//  APath内のdprファイルを,サブフォルダ内も含めて再帰的に検索
//  フルパスで取得し引数のFileListに格納
//  CheckBox1をチェックしている場合はexe作成済みのプロジェクトを除外
//=============================================================================
procedure TForm1.GetdprFilesListAll(APath: String; FileList: TStringList);
var
  AList   : TStringDynArray;
  i       : Integer;
  exeName : String;
begin
  AList := TDirectory.GetFiles(APath, '*.dpr', TSearchOption.soAllDirectories);
  for i := 0 to Length(AList) - 1 do begin
    if CheckBox1.Checked then begin
      exeName := ChangeFileExt(AList[i], '.exe');
      if not FileExists(exeName) then begin
        FileList.Add(AList[i]);
      end;
    end else begin
      FileList.Add(AList[i]);
    end;
  end;
end;

//=============================================================================
//  コンパイル実行のメソッド
//
//  パイプを使用してコンパイル実行メッセージを読み出すようにしている
//  ここで使用しているGrabStdOutTextは,サンプルプログラムの[552_コマンドライン
//  のリダイレクト]参照
//
//  [引数]
//  dccPath    コマンドコンパイラのフルパス
//  FlieList   コンパイル対象のdprファイルのリスト
//=============================================================================
function TForm1.ComplieProject(dccPath: String; FileList: TStringList): Integer;
var
  ProjName  : String;
  OptionStr : String;
  i         : Integer;
  ACmdLine  : TplCommandRedirect;
  ACmdStr   : String;
begin
  Screen.Cursor := crHourGlass;
  Result := 0;
  ControlsEnabled(Panel1,False);
  btnCancel.Enabled := True;

  Memo1.Clear;
  Update;
  CancelFlag            := False;
  Label1.Caption        := IntToStr(0) + '/' + IntToStr(FileList.Count);
  ProgressBar1.Position := 0;
  ProgressBar1.Visible  := True;

  ACmdLine := TplCommandRedirect.Create;

  try
    ProgressBar1.Min := 0;
    ProgressBar1.Max := FileList.Count;

    for i := 0 to FileList.Count - 1 do begin
      OptionStr := CreateCommandLineStr(dccPath, FileList[i]);
      ProjName  := AnsiQuotedStr(FileList[i], '"');

      //-Uオプションで対象プロジェクトのフォルダを指定しているがうまく働か
      //ないプロジェクトがあるので,ここでカレントディレクトリを変更してみ
      //た.現在のところOKのようである
      SetCurrentDir(ExtractFileDir(FileList[i]));

      //エラーが発生しないとファイル名を表示しないので追加
      Memo1.Lines.Add(FileList[i]);

      //プロジェクトをコマンドラインコンパイラでコンパイル
      ACmdStr := dccPath + ' ' + ProjName + '' + OptionStr;
      Memo1.Lines.Add(ACmdLine.GrabStdOutText(ACmdStr));
      Memo1.Lines.Add(sLineBreak);

      ProgressBar1.Position := i + 1;
      Label1.Caption := IntToStr(i+1) + '/' + IntToStr(FileList.Count);
      ProgressBar1.Update;
      Label1.Update;

      Application.ProcessMessages;
      if CancelFlag then break;
    end;
  finally
    FreeAndNil(ACmdLine);
    //カレントディレクトリをこのフォルダに戻す
    SetCurrentDir(ExtractFileDir(Application.ExeName));

    ControlsEnabled(Panel1,True);
    btnCancel.Enabled := False;
  end;
  ProgressBar1.Visible := False;
  Screen.Cursor := crDefault;
end;

//=============================================================================
//  コンパイルオプションの文字列を作成する関数
//  コマンドコンパイラ(dcc32.exe)は以下の順番にコンパイルオプションの設定を読み
//  出してオーバライドして使用する
//  このメソッドで作成しているのは(4)
//  引数のProjNameがプロジェクトのフルパス(dprファイル)
//  検索(ライブラリ)パスとして,コンパイル対象のファイルがある1つ上の階層のフォ
//  ルダも追加している
//
//  (1) $(DELPHI)Binまたは$(BDS)Binのdcc32.cfg
//  (2) カレントディレクトリのdcc32.cfg
//  (3) コンパイル対象プロジェクトのディレクトリのdcc32.cfg
//  (4) コマンドラインで指定したオプション文字列
//
//  コンパイルオプション(Pipeによる出力にも影響する)
//  -A  ユニットのエイリアス設定.
//  -B  再構築.DLLやリソースファイルの修正をプロジェクトのEXEに反映するにため
//      には再構築が必要.
//  -U  ライブラリパスの指定.複数の時は;(セミコロン)で区切る.
//      IDEの[ツール][環境オプション]の[ライブラリ]タブに相当するが,コマンドラ
//      インコンパイラの場合は,複数のユニットを使用する場合,そのプロジェクト
//      のフォルダも指定する必要がある.
//  -E  作成したEXEファイルの置き場所.これを指定しなくても.dprと同じフォルダに
//      EXEファイルができるが,このオプションを指定しないと,DLLがカレントディ
//      レクトリ(このComplieAllProjet)にできてしまう.
//  -R  リソースファイル検索パス.
//  -H  ヒントメッセージの表示(Pipeに出力する).
//  -W  警告メッセージの出力(Pipeに出力する)
//  -Q  Quietモード.コンパイル中のファイル名と行番号の表示をしない.起動時の著
//      作権メッセージと終了時のコンパイル結果の情報だけを表示.エラーが生じた場
//      合も表示(ここで表示とはPipeに出力するという意味).
//=============================================================================
function TForm1.CreateCommandLineStr(dccPath: String; ProjName: String): String;
var
  TabName        : String;
  ConfigFileName : String;
  SL             : TStringList;
  Str            : String;
  ProjDir        : String;
  i              : Integer;
  iPos           : Integer;
begin
  ProjDir := ExtractFileDir(ProjName);
  SL      := TStringList.Create;

  TabName        := TabControl1.Tabs[TabControl1.TabIndex];
  ConfigFileName := ExtractFilePath(Application.ExeName) +
                    'LibPath' + TabName + '.CFG';

  try
    SL.LoadFromFile(ConfigFileName);

    //ヒントと警告は対象ユニットで表示オプションがある時は無効
    //ChekBox2は再構築の指定
    if CheckBox2.Checked then Str := Str + ' -B';

    //ChekBox3はヒント表示の指定
    if CheckBox3.Checked then Str := Str + ' -H+' else Str := Str + ' -H-';

    //ChekBox4は警告表示の指定
    if CheckBox4.Checked then Str := Str + ' -W+' else Str := Str + ' -W-';

    Str := Str + ' -Q';
    Str := Str + ' -E' + AnsiQuotedStr(ProjDir, '"');
    Str := Str + ' -R' + AnsiQuotedStr(ProjDir, '"');

    //Delphi XE2以降の場合
    //ユニットスコープ名(Delphi XE2のプロジェクトオプションからコピーしたリスト)
    //これだけでは不足しているかも知れない
    iPos := Pos('XE', TabName);
    if iPos > 0 then begin
      if Length(Trim(TabName)) >= (iPos + 2) then begin
        if CharInSet(TabName[iPos + 2], ['1'..'9']) then begin
         Str := Str + ' -NS'
                + 'Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;'
                + 'Soap.Win;Xml.Win;Bde;System;Xml;Data;Datasnap;Web;'
                + 'Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell';
        end;
      end;
    end;

    //ライブラリパスの追加
    Str := Str + ' -U';
    for i := 0 to SL.Count - 1 do begin
      if i = 0 then begin
        Str := Str + AnsiQuotedStr(SL[i], '"');
      end else begin
        Str := Str + ';' + AnsiQuotedStr(SL[i], '"');
      end;
    end;
    //対象プロジェクトとその1つ上の階層のフォルダを検索対象として追加
    Str := Str + ';' + AnsiQuotedStr(ProjDir, '"');
    Str := Str + ';' + AnsiQuotedStr(ExtractFileDir(ProjDir), '"');
    Result := Str;
  finally
    FreeAndNil(SL);
  end;
end;

//=============================================================================
//  [キャンセル]
//=============================================================================
procedure TForm1.btnCancelClick(Sender: TObject);
begin
  CancelFlag := True;
end;

//=============================================================================
//  引数のWCで指定するコントロール上のコントロールのEnabledプロパティを設定
//  TPanelの上に載っているコントロールはTPanelをDisalbeにすれば操作不可になる
//  が視覚的効果がないので,ここで設定
//=============================================================================
procedure TForm1.ControlsEnabled(WC: TWinControl; Flag: Boolean);
var
  i  : Integer;
  CC : TControl;
begin
  if WC.ControlCount = 0 then exit;
  for i:=0 to WC.ControlCount-1 do begin
    CC := WC.Controls[i];
    CC.Enabled := Flag;
    if CC is TWinControl then ControlsEnabled(TWinControl(CC),Flag);
  end;
end;

//=============================================================================
//  タブコントロールのタブを切り替えたら
//=============================================================================
procedure TForm1.TabControl1Change(Sender: TObject);
var
  ConfigIniFile  : TIniFile;
  ConfigFileName : String;
  SL             : TStringList;
  TabName        : String;
begin
  ConfigIniFile  := TIniFile.Create(IniFileName);
  TabName        := TabControl1.Tabs[TabControl1.TabIndex];
  ConfigFileName := 'LibPath' + TabName + '.CFG';

  try
    //チェックボックスの設定内容がiniファイルにあれば読み出し
    if (FileExists(IniFileName) and
       (ConfigIniFile.SectionExists(TabName))) then begin
      CheckBox1.Checked := ConfigIniFile.ReadBool(TabName, 'Checkbox1', False);
      CheckBox2.Checked := ConfigIniFile.ReadBool(TabName, 'Checkbox2', False);
      CheckBox3.Checked := ConfigIniFile.ReadBool(TabName, 'Checkbox3', True);
      CheckBox4.Checked := ConfigIniFile.ReadBool(TabName, 'Checkbox4', True);
    end;
    ConfigIniFile.WriteString('Common', 'TabName', TabName);
  finally
    FreeAndNil(ConfigIniFile);
  end;

  //ライブラリパスの設定ファイルがなければ調査して保存
  //初めてタブを切り換えた場合のみ実行される
  if not FileExists(ConfigFileName) then begin
    SL := TStringList.Create;
    try
      //ライブラリパスの検出
      SetDefaultLibPath(TabName, ConfigFileName, SL);
      SL.SaveToFile(ConfigFileName);
    finally
      FreeAndNil(SL);
    end;
  end;
end;

//=============================================================================
//  コンパイルの条件設定用のチェックボックスの状態を変更したら,それをIniファ
//  イルに保存
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
var
  TabName       : String;
  ConfigIniFile : TIniFile;
begin
  ConfigIniFile := TIniFile.Create(IniFileName);
  TabName       := TabControl1.Tabs[TabControl1.TabIndex];

  try
    ConfigIniFile.WriteBool(TabName, 'Checkbox1', CheckBox1.Checked);
    ConfigIniFile.WriteBool(TabName, 'Checkbox2', CheckBox2.Checked);
    ConfigIniFile.WriteBool(TabName, 'Checkbox3', CheckBox3.Checked);
    ConfigIniFile.WriteBool(TabName, 'Checkbox4', CheckBox4.Checked);
  finally
    FreeAndNil(ConfigIniFile);
  end;
end;

//=============================================================================
//  DelphiのIDEで設定してあるライブラリパスを追加
//  ライブラリパスの取得方法がわからないのでレジストリから取得
//  重複するパスの文字列は追加しない
//  ただし$(DELPHI)や$(BDS)等は別文字列として扱っている
//
//  例えばDelphi7の場合,$(DELPHI)とC:\Program Files\Borland\Delphi7\binは実際
//  には同じパスを意味しているが,ここでは重複してしまう
//=============================================================================
procedure TForm1.SetDefaultLibPath(TabName, ConfigFileName: String;
  SL: TStringList);
var
  ConfigIniFile : TIniFile;
  Reg           : TRegistry;
  AppKey        : String;
  AppItem       : String;
begin
  //IniファイルからKEY値を読み出す
  //ルートキーがHKEY_CURRENT_USERと仮定して,EXE起動時にKEY項目を取得すみ
  ConfigIniFile := TIniFile.Create(IniFileName);
  try
    AppKey := ConfigIniFile.ReadString(TabName, 'AppKeyLib', '');
  finally
    FreeAndNil(ConfigIniFile);
  end;

  Reg := TRegistry.Create;
  try
    Reg.Access  := KEY_READ;
    Reg.RootKey := HKEY_CURRENT_USER;
    AppItem     := 'Search Path';

    SL.Sorted        := True;
    SL.Duplicates    := dupIgnore;
    SL.CaseSensitive := False;

    if Reg.OpenKey(AppKey, False) then begin
      try
        SL.Delimiter       := ';';
        SL.StrictDelimiter := True;
        SL.DelimitedText   := Reg.ReadString(AppItem);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;
end;

end.



リスト2
ライブラリパスの編集用コード
unit EditLibraryPath;

interface

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

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    btnAdd: TButton;
    btnDelete: TButton;
    Panel2: TPanel;
    btnAddDelphiPath: TButton;
    ListView1: TListView;
    ApplicationEvents1: TApplicationEvents;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnAddDelphiPathClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private 宣言 }
    IniFilename : String;
    ConfigFileName : String;
    TabName : String;
    procedure AddOriginLibPath(APath: String);
  public
    { Public 宣言 }
  end;

var
  Form2: TForm2;

implementation

uses CommandLineCompileUnit, FileCtrl,IniFiles, ShellAPI;

{$R *.dfm}

//=============================================================================
//  フォームを表示したら各種設定値をiniファイルとライブラリバスを保存している
//  ファイルから読み出して表示
//=============================================================================
procedure TForm2.FormShow(Sender: TObject);
var
  ConfigIniFile : TIniFile;
  AFormTop      : Integer;
  AFormLeft     : Integer;
  AFormWidth    : Integer;
  AFormHeight   : Integer;
  SL            : TStringList;
  i             : Integer;
begin
  btnDelete.Enabled := False;

  IniFilename    := Form1.IniFileName;
  TabName        := Form1.TabControl1.Tabs[Form1.TabControl1.TabIndex];
  ConfigFileName := 'LibPath' + TabName + '.CFG';

  Self.Caption := Self.Caption + ' ' + TabName;
  AFormTop    := 0;
  AFormLeft   := 0;
  AFormWidth  := 0;
  AFormHeight := 0;

  ConfigIniFile := TIniFile.Create(IniFileName);
  try
    if FileExists(IniFileName) then begin
      AFormTop    := ConfigIniFile.ReadInteger('Common', 'EditFormTop',    0);
      AFormLeft   := ConfigIniFile.ReadInteger('Common', 'EditFormLeft',   0);
      AFormWidth  := ConfigIniFile.ReadInteger('Common', 'EditFormWidth',  0);
      AFormHeight := ConfigIniFile.ReadInteger('Common', 'EditFormHeight', 0);
    end;
  finally
    FreeAndNil(ConfigIniFile);
  end;

  if AFormTop    > 0 then Self.Top    := AFormTop;
  if AFormLeft   > 0 then Self.Left   := AFormLeft;
  if AFormWidth  > 0 then Self.Width  := AFormWidth;
  if AFormHeight > 0 then Self.Height := AFormHeight;

  ListView1.Items.Clear;
  SL := TStringList.Create;
  SL.Sorted := True;
  SL.Duplicates := dupIgnore;
  try
    if FileExists(ConfigFileName) then begin
      SL.LoadFromFile(ConfigFileName);
      for i := 0 to SL.Count -1 do begin
        if Trim(SL[i]) <> '' then ListView1.Items.Add.Caption := Trim(SL[i]);
      end;
    end else begin
      //Delphiパス取込
      btnAddDelphiPathClick(nil);
    end;
  finally
    FreeAndNil(SL);
  end;

  //ドラッグアンドドロップを許可
  //usesにShellAPIが必要
  DragAcceptFiles(ListView1.Handle, True);
end;

//=============================================================================
//  フォームを閉じる時は現在の設定値を保存
//  保存するのは,ライブラリパス名とこのフォームの表示位置とサイズ
//=============================================================================
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
var
  SL            : TStringList;
  i             : Integer;
  ConfigIniFile : TIniFile;
  Str           : String;
begin
  SL := TStringList.Create;
  try
    for i := 0 to ListView1.Items.Count - 1 do begin
      Str := Trim(ListView1.Items[i].Caption);
      if Str <> '' then SL.Add(Str);
    end;
    SL.SaveToFile(ConfigFileName);
  finally
    FreeAndNil(SL);
  end;

  ConfigIniFile := TIniFile.Create(IniFileName);
  try
    ConfigIniFile.WriteInteger('Common', 'EditFormTop',    Self.Top);
    ConfigIniFile.WriteInteger('Common', 'EditFormLeft',   Self.Left);
    ConfigIniFile.WriteInteger('Common', 'EditFormWidth',  Self.Width);
    ConfigIniFile.WriteInteger('Common', 'EditFormHeight', Self.Height);
  finally
    FreeAndNil(ConfigIniFile);
  end;
end;

//=============================================================================
//  フォームをリサイズしたらListViewの表示幅も変更
//=============================================================================
procedure TForm2.FormResize(Sender: TObject);
begin
  ListView1.Column[0].Width := ListView1.ClientWidth -
                               GetSystemMetrics(SM_CXHSCROLL);
end;

//=============================================================================
//  [追加]
//  フォルダ選択ダイアログを表示して選択
//  初期フォルダは,Iniファイルに保存してある値を使用.それがなければこのプロ
//  グラムがあるフォルダ
//  フォルダを選択したら,そのフォルダ名をIniファイルに記録しておく
//=============================================================================
procedure TForm2.btnAddClick(Sender: TObject);
var
  ConfigIniFile : TIniFile;
  BasePath      : String;
begin
  ConfigIniFile := TIniFile.Create(IniFileName);

  try
    if FileExists(IniFileName)then begin
      BasePath := ConfigIniFile.ReadString('Common', 'EditBasePath', '');
    end else begin
      BasePath := ExtractFileDir(Application.ExeName);
    end;

    if SelectDirectory('ライブラリパス追加', '', BasePath) then begin
      AddOriginLibPath(ExcludeTrailingPathDelimiter(BasePath));
      ConfigIniFile.WriteString('Common', 'EditBasePath', BasePath);
    end;
  finally
    FreeAndNil(ConfigIniFile);
  end;
  btnDelete.Enabled := False;
end;

//=============================================================================
//  [削除]
//  現在選択中のパスの設定を削除
//=============================================================================
procedure TForm2.btnDeleteClick(Sender: TObject);
begin
  ListView1.DeleteSelected;
end;

//=============================================================================
//  [Delphiパス取込]
//  DelphiのIDEで設定してあるライブラリパスを追加
//=============================================================================
procedure TForm2.btnAddDelphiPathClick(Sender: TObject);
var
  SL     : TStringList;
  SLAdd  : TStringList;
  i      : Integer;
  Str    : String;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;

  SL    := TStringList.Create;
  SLAdd := TStringList.Create;
  SL.Sorted     := True;
  SL.Duplicates := dupIgnore;

  for  i := 0 to ListView1.Items.Count -1 do begin
    Str := Trim(ListView1.Items[i].Caption);
    if Str <> ''  then SL.Add(Str);
  end;
  try
    Form1.SetDefaultLibPath(TabName, ConfigFileName, SLAdd);
    for i := 0 to SLAdd.Count - 1 do begin
      Str := Trim(SLAdd[i]);
      if Str <> '' then SL.Add(SLAdd[i]);
    end;
    for i := 0 to SL.Count - 1 do begin
      ListView1.Items.Add.Caption := SL[i];
    end;
  finally
    FreeAndNil(SL);
    FreeAndNil(SLAdd);
  end;

  ListView1.Items.EndUpdate;
  btnDelete.Enabled := False;
end;

//=============================================================================
//  リストビューをクリックしたら,[削除]ボタンのEnabledを設定
//=============================================================================
procedure TForm2.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  btnDelete.Enabled := ListView1.SelCount > 0;
end;

//=============================================================================
//  エクスプローラからのファイルのドラッグ・ドロップ処理
//  ただし1つだけの場合のみ有効
//=============================================================================
procedure TForm2.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  ACount        : Integer;
  Buf           : array [0..MAX_PATH] of Char;
  DragFullPath  : String;
begin
  if Msg.message =WM_DROPFILES then begin
    if (FindDragTarget(Msg.pt, False) = ListView1) then begin
      ACount := DragQueryFile(Msg.wParam, High(DWORD), nil, 0);
      try
        if ACount = 1 then begin
          DragFullPath := '';
          DragQueryFile(Msg.WParam, 0, Buf, MAX_PATH);
          DragFullPath := Buf;
          AddOriginLibPath(DragFullPath);
        end;
      finally
        //ドロップが完了したことを伝える
        DragFinish(msg.WParam);
      end;
    end;
  end;
end;

//=============================================================================
//  ライブラリパスに,引数のAPathを追加
//  重複しないための処理用関数
//=============================================================================
procedure TForm2.AddOriginLibPath(APath: String);
var
  SL  : TStringList;
  Str : String;
  i   : Integer;
begin
  //重複を避けるためにパスのリストを一度TStringListに 退避
  SL := TStringList.Create;
  SL.Sorted     := True;
  SL.Duplicates := dupIgnore;
  for  i := 0 to ListView1.Items.Count -1 do begin
    Str := Trim(ListView1.Items[i].Caption);
    if Str <> ''  then SL.Add(Str);
  end;

  //TStringListに退避したのでTListViewはクリア
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;

  try
    if DirectoryExists(APath) then begin
      SL.Add(APath);
    end;

    //作成したパスリストをTListViewに表示
    for i := 0 to SL.Count - 1 do begin
      ListView1.Items.Add.Caption := SL[i];
    end;
  finally
    FreeAndNil(SL);
  end;

  ListView1.Items.EndUpdate;
  btnDelete.Enabled := False;
end;

end.




02_コンポーネントをインストールしないで動作確認


コマンドラインコンパイラでコンパイルすると,コンパイル対象のプロジェクトで使用しているコンポーネントをインストールしなくてもコンパイルできます.

コンポーネントのファイルは,パスの通ったフォルダに必要ですが,これは [パスの編集] で追加しておきます.添付のテスト用のプロジェクトでは 1 つ上の階層のフォルダにあります.この場合はパスを通す必要はありません.プロジェクトのフォルトの 1 つ上のフォルダも,実行時に自動でパスを通すようにしています.
ネット上で配布されているコンポーネント類のデモ,サンプルのプログラムには,リソースファイルがないものがあります.そのようなプロジェクトはコンパイルできません.


添付のテスト用プロジェクトは,[140_オブジェクトリスト ( クラス型 ) の保存 - TLabel] で使用している,画像表示機能付き縦横両用ラベルコンポーネントをフォームに配置しています.



  • 図5
  • プロジェクトファイル (dpr) のドラッグ・アンド・ドロップでコンパイル開始

図6
添付のテスト用プロジェクト
図7
コンパイルした結果
  • CompoTest.exe が出来ている
図8
EXE を実行

リスト3
テスト用のプロジェクトのフォームのユニット
TplVertLabel というビジュアルコンポーネントを3つフォームに配置している
Delphi XE2 でもコンパイルできるように,uses にユニットスコープ名を付けている
unit CompoTestUnit;

interface

uses
  {$IF CompilerVersion > 22.99}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 
  Vcl.StdCtrls, plVertLabel;
  {$ELSE}
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, plVertLabel;
  {$IFEND}

type
  TForm1 = class(TForm)
    plVertLabel1: TplVertLabel;
    plVertLabel2: TplVertLabel;
    plVertLabel3: TplVertLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.




03_uses 部にユニットスコープ名を追加 ( Delphi XE2 以上用 )


uses 部のユニット名に,ユニットスコープ名を付けるプログラムを作成してみました.
Delphi XE2 よりも前のバージョンのコードを変換するのに利用できます.Embarcadero のサイトのデータを使用しますので.以下の手順で操作してください.

まず,Delphi のオンラインヘルプの [ユニット名とユニット スコープ名のアルファベット順一覧] のページを表示します

  • (1) そのページのリファレンス一覧をコピーします (=のある行を全て)
  • (2) 添付の UnitScopeList.txt を開きます.このファイルの中身は空です
  • (3) この UnitScopeList.txt にコピーしたテキストを貼り付けて,保存します
  • (4) AddUnitScopeUses.exe を起動します
  • (5) 拡張子が .pas または .dpr のファイルを,エクスプローラからドラッグ・ドロップします
  • (6) 変換結果が表示されます.これで OK なら [保存] ボタンで保存します (上書き保存です)

プロジェクトのソース (.dpr) は,Forms という部分だけにユニットスコープ名を付加します.逆にユニットスコープ名付きだけの uses 部の場合は,ユニットスコープ名なしのユニット名を,コンパイラのバージョン分岐を挿入して追加します.
なお,このプログラムのソースコードは添付していません.整備中です.

このプログラムは,特に管理者権限 [管理者として実行] する必要はありません.




  • 図9
  • ユニット名にユニットスコープ名を付加するプログラム
  • [保存] ボタンで上書き保存

リスト4
上の図の,元のコード
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.




04_ドラッグ・アンド・ドロップ機能の実装 ( Vista 以降の UIPI 対応 )


エクスプローラ等からのドラッグ・アンド・ドロップは,WM_DROPFILES メッセージを受信した後,関数 DragQueryFile で処理が可能です.
しかし,Windows Vista 以降では,ユーザーインタフェイス特権の分離 (UIPI) の機能のため,エクスプローラからのファイル名のドラッグ・アンド・ドロップができないことがあります.

コマンドラインコンパイラは,管理者権限で実行しないとコンパイルできません.一方,エクスプローラは通常,少し低い権限での起動となっています.高い権限で起動しているアプリケーションは,自分より低い権限で起動しているアプリケーションからのメッセージの受信に制限があります.
つまり,下からの要求には応じないというわけです.

逆の場合は可能です.つまり,同レベルと上からの指示は受け取ることになっています.
これが「ユーザインターフェイス特権の分離 (UIPI)」機能によって発生する現象の一部です.
したがって,Delphi の IDE から実行したプログラムは,エクスプローラからのドラッグ・アンド・ドロップができない場合があります.作成した EXE を一般ユーザで起動した場合は可能です.

そこで,ChangeWindowMessageFilter という関数で,ドラッグ・アンド・ドロップに関係するメッセージの受信を許可するために,以下のようなコードを追加しました.
ドラッグ・アンド・ドロップのメッセージは,WM_DROPFILES メッセージですが,実際には,関係する他のメッセージも同時に許可する必要があります.これは他の Windows のメッセージでも同じです.

ChangeWindowMessageFilter 関数は,Windows XP 以前にはありません.GetProcAddress 関数で,該当する DLL 内にこの関数があるかを確認してから処理しています.そうしないと,Windows XP でコンパイルできないコードとなってしまいます.これを,dll の動的リンクと言っています.



[備考 1]
ChangeWindowMessageFilter 関数,MSGFLT_ADD, MSGFLT_REMOVE, WM_COPYGLOBALDATA も Delphi XE5 には実装されています.関数と定数値の定義文を書く必要はありません.

[備考 2]
UIPI は,メッセージの送受信に関する機能です.影響を受けるのは,ドラッグ・ドロップ関係だけではありません.例えば,管理者権限で実行しているアプリの表示位置を SetWindowPos 関数を使用して変更しようとしても,一般ユーザで起動したアプリからは変更できません.




リスト5
Windows Vista 以降でファイル名のドラッグ・アンド・ドロップを実現するめに追加したコード
ChangeWindowMessageFilter 関数で,メッセージの受信を許可する
const
  MSGFLT_ADD = 1;
  MSGFLT_REMOVE = 2;
  WM_COPYGLOBALDATA = $0049;

procedure TForm1.FormCreate(Sender: TObject);
var
  DLLHandle  : THandle;
  FuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
  ....
begin
  if CheckWin32Version(6, 0) then begin
    DLLHandle := loadLibrary('user32.dll');
    try
      if DLLHandle > 0 then begin
        @FuncFilter := GetProcAddress(DLLHandle, 'ChangeWindowMessageFilter');
        if @FuncFilter <> nil then begin
          FuncFilter(WM_DROPFILES,      MSGFLT_ADD);
          FuncFilter(WM_COPYDATA,       MSGFLT_ADD);
          FuncFilter(WM_COPYGLOBALDATA, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  ...
  ...

end;


アプリケーション間のメッセージ通信の問題に対応する別の方法があります.そのためには,
  • アプリケーション マニフェストに通信を許可するコードがある
  • デジタル署名 ( コードサイニング証明書 ) を取得している
  • アプリケーションの実行ファイルが %ProgramFiles% フォルダにある

という条件が必要です.詳しい内容は,参考リンクのマイクロソフトの記事にあります.
メッセージの受信許可の設定には注意が必要です.間違って他のユーザのファイルを操作するような設定をしてしまう恐れもあります.



[備考]
エクスプローラの操作権限は,その環境にもよります.例えば,ネットワーク上のドライブのフォルダを開く際,管理者権限が必要であれば,管理者権限で起動することになります.
この場合も,どの操作が可能であるかは,セキュリティの設定も関係してきます.
この仕様は,Windows XP の時代にはすでに実装されていました.Windows Vista では,UAC の実装に伴って,確実に機能するようになったとも言えます.




05_Window 7 64 ビット版のレジストリの構成


このコマンドラインコンパイラの実行では,レジストリからコンパイラの情報を取得しています.
もし,64 ビットの EXE を作製した場合,レジストリからの読み出しと,コマンドコンパイラの実行に注意が必要です.そこで,レジストリへのアクセスの簡単なテストをしてみました.
このテストは,64 ビット版の Windows のみで意味のある内容となっています.

64 ビット版の Windows 7 には,32 ビットバージョンのレジストリエディタと 64 ビットバージョンのレジストリエディタがあります.
64 ビットのアプリケーション関係はもちろん 64 ビットバージョンのレジストリに書き込まれます.32 ビットのアプリケーションの [HKEY_LOCAL_MACHINE] [SOFTWARE] 関係の情報は,32 ビットバージョンのレジストリに書き込まれますが,64 ビットバージョンのレジストリにも書き込まれます.そこは,下図のように,


[HKEY_LOCAL_MACHINE] [SOFTWARE] [Wow6432Node]

という場所です.

通常はリダイレクト機能が働くので,特にこのキー項目を意識する必要はありません.
問題となるのは,32 ビットのアプリから 64 ビットバージョンのレジストリを操作するとか,64 ビットのアプリから 32 ビットバージョンのレジストリを操作する時です.

この後のサンプルは,この動作を確認するためのテストプログラムです.


64 ビット版の Windows の 32 ビット版レジストリエディタは,次のコマンドで起動できます.
[ファイル名を指定して実行] のダイアログで,以下をコピペしても起動できます.
32 ビット版の Windows には,このレジストリエディタは存在しません.

32 ビット版の Windows のレジストリエディタは,RegEdit.exe または RegEdit コマンドだけで起動できます.


C:\Windows\SysWOW64\Regedit


図10
64 ビットバージョンのレジストリの内容
  • [Wow6432Node] に 32 ビット版アプリの情報がある
図11
32 ビットバージョンのレジストリの内容
  • 64 ビットバージョンのレジストリの [Wow6432Node] と同じ内容が格納されている (全てではない)
  • 32 ビット版のレジストリエディタは [ファイル名を指定して実行] から C:\Windows\SysWOW64\Regedit で起動できる




06_レジストリへのアクセスとアプリの起動  -  32 ビットアプリから


実際のレジストリの操作として,レジストリの読み出しだけをテストしてみます.
読み出しだけであれは,特に管理者としての実行は必要ありません.起動するアプリが管理者権限実行されるかどうかは,このテストプログラムを管理者権限で実行するかどうかで決まります.

Delphi 自身は 32 ビットのアプリケーションです.そこで,ここでは,Windows 7 に標準で実装されている PowerShell を起動します.PowerShell は 32 ビット版と 64 ビット版があります.
PowerShell の実行ファイル名は,レジストリの下図の Path 項目に記録されています.

このテストは,64 ビット版の Windows のみで意味のある内容となっています.
Windows が 32 ビット版か 64 ビット版かの判定はしていません.



図12
PowwrShell

テストは以下の手順で行います.
  • (1) PowerShell の実行ファイル EXE のフルパスをレジストリから読み取る
  • (2) ShellExecuteEx 関数を使用して,PowerShell を起動する
  • (3) 起動したプロセスハンドルから実際に 32 bit 版か 64 bit 版なのかを判定する

このテストプログラムは,32 ビットのアプリケーションから,32 ビットと 64 ビットのレジストリから PowserShell の EXE のフルパスを取得します.
添付のサンプルプロジェクトは,ターゲットプラットフォームを 32 ビットとしています.

この方法は,システム関係内のフォルダにあるアプリケーションでは利用できるとは限りません.システム関係のアプリケーションは,基本的に,ファイルシステムのリダイレクト機能により,System32 フォルダを指定しても SysWOW64 フォルダ内をアクセスしてしまいます.
実行可能かの基準ついては筆者には分かりません.実行してみて確認するしかないようです.




図13
設計時画面
図14
32 ビット版を起動
  • [SysWOW64] 内の PowerShell が起動
図15
起動した 32 ビット版の PowerShell
  • カレントディレクトリは,このプロジェクトのフォルダ
図16
64 ビット版を起動
  • 確かに 64 ビット版となっている
図17
64 ビット版のフォルダ
  • [System32] となっている

リスト6
32 ビットアプリから 32 ビット版または 64 ビット版の PowerShell を起動
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    ProcessHandle : Cardinal;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses SHellAPI, Registry;

{$R *.dfm}

//----------------------------------------------------------------------------
//  ShellExecuteExでEXE実行
//  ShellExecuteExはファイル(拡張子)の関連付けでアプリを起動できる
//  SEE_MASK_NOCLOSEPROCESSは,ShellExecuteEx終了後もプロセスを実行したままにする
//  この指定がないとTShellExecuteInfo.Processでプロセスのハンドルが取得できない
//
//  ShellExcuteExの使用にはusesにShellAPIが必要
//----------------------------------------------------------------------------
function RunExeFile(hWnd: HWND; AFile: String; AParameters: String;
   Verb: String): Cardinal;
var
  AInfo : TShellExecuteInfo;
  ret   : DWORD;
begin
  FillChar(AInfo, SizeOf(AInfo), 0);
  AInfo.cbSize := SizeOf(AInfo);
  AInfo.Wnd    := hWnd;
  AInfo.fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  AInfo.lpVerb := PChar(Verb);

  AInfo.lpFile       := PChar(AFile);
  AInfo.lpParameters := PChar(AParameters);
  AInfo.nShow        := SW_SHOW;

  ShellExecuteEx(@AInfo);

  //ShellExecuteExは成功するとhInstAppに33以上の値を返す
  if AInfo.hInstApp >= 33 then begin
    //起動終了まで待つための処理
    repeat
      ret := WaitForInputIdle(AInfo.hProcess, 50);
      Application.ProcessMessages;
      Sleep(100);
    until ret <> WAIT_TIMEOUT;
  end;
  //戻値は起動プロセスのハンドルとする
  Result := AInfo.hProcess;
end;

//=============================================================================
//  32bitアプリで,32bit版のアプリのフルパスをレジストリから取得
//  ここでは,32bit版のPowerShellのフルパスを取得
//
//  64ビット版Windows専用のコードなので注意
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Reg         : TRegistry;
  AppKey      : String;
  AppItem     : String;
  AppFullPath : String;
  IsWOW64     : BOOL;
  StrText     : String;
begin
  Reg := TRegistry.Create;

  try
    //KEY_READ or KEY_WOW64_32KEY;のように32bitであることを明示してもよい
    Reg.Access  := KEY_READ;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    AppKey      := 'SOFTWARE\Microsoft\PowerShell\1\ShellIds\Microsoft.PowerShell';
    AppItem     := 'Path';

    if Reg.OpenKey(AppKey, False) then begin
      try
        AppFullPath := Reg.ReadString(AppItem);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;

  Edit1.Text := AppFullPath;

  //起動し,プロセスのハンドルを取得
  //独立起動とするので,第1引数を0とする
  ProcessHandle := RunExeFile(0, AppFullPath, '', '');

  if ProcessHandle <> 0 then begin
    //起動したプロセスのビットバージョンを調査
    IsWow64Process(ProcessHandle, IsWOW64);
    if IsWOW64 then begin
      MessageBox(Handle, '32 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end else begin
      MessageBox(Handle, '64 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end;
  end else begin
    StrText := 'PowerShell の起動に失敗しました';
    MessageBox(Handle, PChar(StrText), 'PowerShell', MB_OK or MB_ICONASTERISK);
  end;
end;

//=============================================================================
//  32bitアプリで,64bit版のアプリのフルパスをレジストリから取得
//  ここでは,64bit版のPowerShellのフルパスを取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  Reg         : TRegistry;
  AppKey      : String;
  AppItem     : String;
  AppFullPath : String;
  IsWOW64     : BOOL;
  StrText     : String;
begin
  Reg := TRegistry.Create;

  try
    //64bitのレジストリにアクセスするには,アクセスフラグにKEY_WOW64_64KEY指定する
    Reg.Access  := KEY_READ or KEY_WOW64_64KEY;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    AppKey      := 'SOFTWARE\Microsoft\PowerShell\1\ShellIds\Microsoft.PowerShell';
    AppItem     := 'Path';

    if Reg.OpenKey(AppKey, False) then begin
      try
        AppFullPath := Reg.ReadString(AppItem);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;

  Edit1.Text := AppFullPath;

  //System32はSysnativeに置き換えないとリダイレクトしてしまう
  //Sysnativeは,32bitアプリから64bitのシステムフォルダへのアクセス用の仮想フォルダ
  AppFullPath := StringReplace(AppFullPath, 'System32', 'Sysnative', []);

  //起動し,プロセスのハンドルを取得
  //独立起動とするので,第1引数を0とする
  ProcessHandle := RunExeFile(0, AppFullPath, '', '');

  if ProcessHandle <> 0 then begin
    //起動したプロセスのビットバージョンを調査
    IsWow64Process(ProcessHandle, IsWOW64);
    if IsWOW64 then begin
      MessageBox(Handle, '32ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end else begin
      MessageBox(Handle, '64ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end;
  end else begin
    StrText := 'PowerShell の起動に失敗しました';
    MessageBox(Handle, PChar(StrText), 'PowerShell', MB_OK or MB_ICONASTERISK);
  end;
end;

//=============================================================================
//  32bitアプリで,64bit版のアプリのフルパスをレジストリから取得
//  ここでは,64bit版のPowerShellのフルパスを取得
//  TRegistry.Createでレジストリへのアクセスフラグを指定する場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  Reg         : TRegistry;
  AppKey      : String;
  AppItem     : String;
  AppFullPath : String;
  IsWOW64     : BOOL;
  StrText     : String;
begin
  //TRegistryのCreate時にアクセスフラグを指定する方法
  //64bitのレジストリにアクセスするには,アクセスフラグにKEY_WOW64_64KEY指定する
  Reg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);

  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    AppKey      := 'SOFTWARE\Microsoft\PowerShell\1\ShellIds\Microsoft.PowerShell';
    AppItem     := 'Path';

    if Reg.OpenKey(AppKey, False) then begin
      try
        AppFullPath := Reg.ReadString(AppItem);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;

  Edit1.Text := AppFullPath;

  //System32はSysnativeに置き換えないとリダイレクトしてしまう
  //Sysnativeは,32bitアプリから64bitのシステムフォルダへのアクセス用の仮想フォルダ
  AppFullPath := StringReplace(AppFullPath, 'System32', 'Sysnative', []);

  //起動し,プロセスのハンドルを取得
  //独立起動とするので,第1引数を0とする
  ProcessHandle := RunExeFile(0, AppFullPath, '', '');

  if ProcessHandle <> 0 then begin
    //起動したプロセスのビットバージョンを調査
    IsWow64Process(ProcessHandle, IsWOW64);
    if IsWOW64 then begin
      MessageBox(Handle, '32 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end else begin
      MessageBox(Handle, '64 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end;
  end else begin
    StrText := 'PowerShell の起動に失敗しました';
    MessageBox(Handle, PChar(StrText), 'PowerShell', MB_OK or MB_ICONASTERISK);
  end;
end;

end.




07_レジストリへのアクセスとアプリの起動  -  64 ビットアプリから


今度は,64 ビットのアプリから 32 ビットまたは 64 ビット版の PowerShell を起動します.
手順は前のサンプルと同じです.
添付のサンプルプロジェクトは,ターゲットプラットフォームを 64 ビットとしています.


図18
設計時画面
図19
32 ビット版を起動
  • 確かに 32 ビット版となっている
図20
32 ビット版のフォルダ
  • [SysWOW64] となっている
図21
64 ビット版を起動
  • [System32] となっている
図22
起動した 64 ビット版の PowerShell
  • カレントディレクトリは,プロジェクトのフォルダとなっている

リスト7
64 ビットアプリから 32 ビット版または 64 ビット版の PowerShell を起動
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses SHellAPI, Registry;

{$R *.dfm}

//----------------------------------------------------------------------------
//  ShellExecuteExでEXE実行
//  ShellExecuteExはファイル(拡張子)の関連付けでアプリを起動できる
//  SEE_MASK_NOCLOSEPROCESSは,ShellExecuteEx終了後もプロセスを実行したままにする
//  この指定がないとTShellExecuteInfo.Processでプロセスのハンドルが取得できない
//
//  ShellExcuteExの使用にはusesにShellAPIが必要
//----------------------------------------------------------------------------
function RunExeFile(hWnd: HWND; AFile: String; AParameters: String;
   Verb: String): Cardinal;
var
  AInfo : TShellExecuteInfo;
  ret   : DWORD;
begin
  FillChar(AInfo, SizeOf(AInfo), 0);
  AInfo.cbSize := SizeOf(AInfo);
  AInfo.Wnd    := hWnd;
  AInfo.fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  AInfo.lpVerb := PChar(Verb);

  AInfo.lpFile       := PChar(AFile);
  AInfo.lpParameters := PChar(AParameters);
  AInfo.nShow        := SW_SHOW;

  ShellExecuteEx(@AInfo);

  //ShellExecuteExは成功するとhInstAppに33以上の値を返す
  if AInfo.hInstApp >= 33 then begin
    //起動終了まで待つための処理
    repeat
      ret := WaitForInputIdle(AInfo.hProcess, 50);
      Application.ProcessMessages;
      Sleep(100);
    until ret <> WAIT_TIMEOUT;
  end;
  //戻値は起動プロセスのハンドルとする
  Result := AInfo.hProcess;
end;

//=============================================================================
//  64bitアプリで,32bit版のアプリのフルパスをレジストリから取得
//  ここでは,32bit版のPowerShellのフルパスを取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Reg         : TRegistry;
  AppKey      : String;
  AppItem     : String;
  AppFullPath : String;
  IsWOW64     : BOOL;
  StrText     : String;
begin
  Reg := TRegistry.Create;

  try
    //32bitのレジストリにアクセスするには,アクセスフラグにKEY_WOW64_32KEY指定する
    Reg.Access  := KEY_READ or KEY_WOW64_32KEY;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    AppKey      := 'SOFTWARE\Microsoft\PowerShell\1\ShellIds\Microsoft.PowerShell';
    AppItem     := 'Path';

    if Reg.OpenKey(AppKey, False) then begin
      try
        AppFullPath := Reg.ReadString(AppItem);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;

  Edit1.Text := AppFullPath;

  //起動し,プロセスのハンドルを取得
  //独立起動とするので,第1引数を0とする
  ProcessHandle := RunExeFile(0, AppFullPath, '', '');

  if ProcessHandle <> 0 then begin
    //起動したプロセスのビットバージョンを調査
    IsWow64Process(ProcessHandle, IsWOW64);
    if IsWOW64 then begin
      MessageBox(Handle, '32 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end else begin
      MessageBox(Handle, '64 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end;
  end else begin
    StrText := 'PowerShell の起動に失敗しました';
    MessageBox(Handle, PChar(StrText), 'PowerShell', MB_OK or MB_ICONASTERISK);
  end;
end;

//=============================================================================
//  64bitアプリで,64bit版のアプリのフルパスをレジストリから取得
//  ここでは,64bit版のPowerShellのフルパスを取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  Reg         : TRegistry;
  AppKey      : String;
  AppItem     : String;
  AppFullPath : String;
  IsWOW64     : BOOL;
  StrText     : String;
begin
  Reg := TRegistry.Create;

  try
    //KEY_WOW64_64KEYがなくても,64bitアプリでは64bitのレジストリにアクセスする
    Reg.Access  := KEY_READ or KEY_WOW64_64KEY;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    AppKey      := 'SOFTWARE\Microsoft\PowerShell\1\ShellIds\Microsoft.PowerShell';
    AppItem     := 'Path';

    if Reg.OpenKey(AppKey, False) then begin
      try
        AppFullPath := Reg.ReadString(AppItem);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    FreeAndNil(Reg);
  end;

  Edit1.Text := AppFullPath;

  //起動し,プロセスのハンドルを取得
  //独立起動とするので,第1引数を0とする
  ProcessHandle := RunExeFile(0, AppFullPath, '', '');

  if ProcessHandle <> 0 then begin
    //起動したプロセスのビットバージョンを調査
    IsWow64Process(ProcessHandle, IsWOW64);
    if IsWOW64 then begin
      MessageBox(Handle, '32 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end else begin
      MessageBox(Handle, '64 ビット版です', 'PowerShell', MB_OK or MB_ICONASTERISK);
    end;
  end else begin
    StrText := 'PowerShell の起動に失敗しました';
    MessageBox(Handle, PChar(StrText), 'PowerShell', MB_OK or MB_ICONASTERISK);
  end;
end;

end.