Owl's perspective: 2012/02

2012年2月29日

IDE Fix Pack 4.7リリース

Andreas HausladenさんのIDE Fix Pack 2009/2010/XE/XE2がアップデートされてVersion 4.7になっています。

IDE Fix Pack 4.7 – Includes support for XE2 Update 4 | Andy’s Blog and Tools

Delphi XE2 Update 4への対応を含め、いくつかの問題への対応が追加されています。

RadPHP XE2 Update 4

RadPHP XE2 Update 4がリリースされています。

28759 RadPHP XE2 Update 4
RadPHP XE2 Update 4 is available now
RadPHP XE2 Update 4 が公開されました

RAD Studio/Delphi/C++Builder XE2 Update 4

RAD Studio/Delphi/C++Builder XE2のUpdate 4がリリースされています。

28758 Delphi XE2 and C++Builder XE2 ISO (includes Update 4)
Update 4 for Delphi XE2, C++Builder XE2 and RAD Studio XE2
Delphi XE2／C++Builder XE2／RAD Studio XE2 Update 4 が公開されました
XE2 Update 4 のリリースノート - RAD Studio XE2 (en)
Delphi XE2／C++Builder XE2 Update 4 における不具合修正リスト (en)

Update 4はFireMonkeyの変更が中心のようです。

2012年2月25日

Prism XE2 Update 5

Prism XE2 Update 5(Version 5.0.31 Build 991)がリリースされています。

28754 Embarcadero Prism XE2 Update 5 (February 2012 Release)
Embarcadero Prism XE2 Update 5 is now available
Embarcadero Prism XE2 Update 5 が公開されました

2012年2月21日

Delphi XEの新機能の一つであるTVirtualMethodInterceptorを使用すると、クラスインスタンスの仮想メソッドの呼び出しに外部から介入することができます(メソッドの呼出前、呼出後、例外の発生に対してそれぞれイベントとして無名メソッドを割り当てることができる)。しかしTVirtualMethodInterceptorの実際の使い方については

TVirtualMethodInterceptorを試す。 - 全力わはー
Entropy Overload: Virtual method interception

ぐらいしか参考になる情報がありません。ということで実際に試してみましょう。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Action1Execute(Sender: TObject);
begin
  MessageDlg('Action1Execute',mtInformation,[mbOk],0)
end;

procedure TForm1.Action2Execute(Sender: TObject);
begin
  MessageDlg('Action2Execute',mtInformation,[mbOk],0)
end;

procedure TForm1.Action3Execute(Sender: TObject);
begin
  MessageDlg('Action3Execute',mtInformation,[mbOk],0)
end;

end.

画面上にボタンがあり、これらのボタンにはActionが割り当てられていてOnClickではこれらのActionが呼び出される、というサンプルプログラムです。ここでボタンをクリックしたときにフォーカスを残したくない、という新たな要求があり、それぞれのActionのOnExecuteの最後に"ActiveControl := nil;"という処理をを追加したいのですが、Actionが多数だと大変です。そこでTVirtualMethodInterceptorを使ってTAction.OnExecuteの呼出後に"ActiveControl := nil;"を実行するようにしてみましょう。まずusesにRTTIユニットを追加し、FormのOnCreateイベントでTVirtualMethodInterceptorを生成してprivate部に用意した変数に格納します。

procedure TForm1.FormCreate(Sender: TObject);
begin
  FVMI := TVirtualMethodInterceptor.Create(TAction);
end;

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

TVirtualMethodInterceptorのコンストラクタのパラメータは対象となるクラスです。次に生成したTVirtualMethodInterceptorのインスタンスのOnAfterイベントを設定します。

  FVMI.OnAfter :=
    procedure(Instance: TObject; Method: TRttiMethod;
              const Args: TArray<TValue>; var Result: TValue)
    begin
      if Method.Name = 'Execute' then
      begin
        ActiveControl := nil;
      end;
    end;

メソッドを実行したあとで、そのメソッドの名前が"Execute"であれば"ActiveControl := nil;"を実行する、という処理になります(OnAfterに割り当てているのは無名メソッドなので、Form1のActiveControlをキャプチャして使用することができます)。さらにそれぞれのアクション(TActionのインスタンス)をProxifyします。

  for I := 0 to ComponentCount - 1 do
  begin
    if Components[I] is TAction then
    begin
      FVMI.Proxify(TAction(Components[I]));
    end;
  end;

では実行してみましょう…うまくいきませんね。Method.Nameが'Execute'になった状態でOnAfterに入ってこないようです(おまけに終了時にエラーになります)。TAction.OnExecuteはTBasicAction.Executeから呼び出されているはずです。ClassesユニットにあるTBasicAction.Executeの定義を見てみましょう。

    function Execute: Boolean; dynamic;

ん？dynamicですと？ヘルプには特定のクラス型の指定されたインスタンスに対する仮想メソッド呼び出しをユーザーが動的にインターセプトできるようにします。とあります。そもそもTVirtualMethodInterceptorなので、動的(dynamic)メソッドはインターセプトできないのはあたりまえですね。どうしましょう…TAction.OnExecuteの呼出経路を探ってみると、TControlにはprotectedなActionLinkというプロパティがあり、割り当てられたActionはこのActionLinkのExecuteメソッド経由で呼び出されるようになっています。そしてこのTBasicActionLink.Executeはvirtualです。ということでここに介入することにします。とはいってもTControl.ActionLinkはprotectedですので、強引にclass helperでアクセスできるようにします。

type
  TButtonHelper = class helper for TButton
  public
    function GetActionLink: TActionLink;
  end;

function TButtonHelper.GetActionLink: TActionLink;
begin
  Result := Self.ActionLink;
end;

これでActionLink.Executeに介入できるようになります。

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  FVMI := TVirtualMethodInterceptor.Create(TActionLink);
  FVMI.OnAfter :=
    procedure(Instance: TObject; Method: TRttiMethod;
              const Args: TArray<TValue>; var Result: TValue)
  begin
    if Method.Name = 'Execute' then
    begin
      ActiveControl := nil;
    end;
  end;

  for I := 0 to ControlCount - 1 do
  begin
    if Controls[I] is TButton then
    begin
      FVMI.Proxify(TButton(Controls[I]).GetActionLink);
    end;
  end;
end;

実行してみましょう。…実行時にエラーになりますね。Proxifyで型が一致していないようです。調べてみるとTButtonのActionLinkのインスタンスの型はTActionLinkではなく派生したTPushButtonActionLinkになっています。

  FVMI := TVirtualMethodInterceptor.Create(TPushButtonActionLink);

こんどはうまく動作したようです。ところで終了時は？やはりEPrivilege例外が発生してエラーになります。Talesさんが指摘していますが、インターセプト対象のインスタンスが解放されるときには仮想メソッドであるdestructor Destroyが呼び出されるわけで、この時点までTVirtualMethodInterceptorのインスタンスを解放してはいけないということになります。ここではこの問題をclass destructorで解決します。

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    class var
      FVMI: TVirtualMethodInterceptor;
  public
    class constructor Create;
    class destructor Destroy;
  end;

TVirtualMethodInterceptorをclass varとして、class constructorで初期化し、class destructorで解放するようにします(TForm1のOnDestroyイベントの"FVMI.Free;"を削除するのを忘れないように)。

class constructor TForm1.Create;
begin
  FVMI := nil;
end;

class destructor TForm1.Destroy;
begin
  FVMI.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  if FVMI = nil then
  begin
    FVMI := TVirtualMethodInterceptor.Create(TPushButtonActionLink);
    FVMI.OnAfter :=
      procedure(Instance: TObject; Method: TRttiMethod;
                const Args: TArray<TValue>; var Result: TValue)
      begin
        if Method.Name = 'Execute' then
        begin
          ActiveControl := nil;
        end;
      end;
    end;

  for I := 0 to ControlCount - 1 do
  begin
    if Controls[I] is TButton then
    begin
      FVMI.Proxify(TButton(Controls[I]).GetActionLink);
    end;
  end;
end;

これですべてうまく動作しました。終了時もエラーになりません。

TVirtualMethodInterceptorがやっていることは基本的にはtalesさんが指摘しているとおりVMTの差し替えです。従って処理に介入できるのはインスタンスの仮想(virtual)メソッドのみで、動的(dynamic)メソッドや静的メソッド、クラスメソッドは対象になりません。またProxifyしたインスタンスが全て解放されるまではTVirtualMethodInterceptorのインスタンスを解放してはいけません(デストラクタはvirtualなのでVMTを参照する)。もうひとつ気をつけなければならないのはTVirtualMethodInterceptorのコンストラクタで指定しているクラス型が実際にProxifyするクラス型と完全に一致していなければならない(代入互換性があるというのではだめ)という点です。

2012/02/29追記: TVirtualMethodInterceptor.OriginalClassプロパティを使ってVMTを書き戻すか、同じことをしてくれるUnproxify(XE2で追加)で終了時の問題をクリアすることができる、という指摘がLynaさんからありました。ということでこちらも試してみます。まずOriginalClassプロパティに格納されているもともとのVMTを書き戻す方法から。

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FVMI: TVirtualMethodInterceptor;
  end;

フォームのクラスコンストラクタ/クラスデストラクタを削除し、TVirtualMethodInterceptorを通常のprivateなフィールドに戻します。またフォームのOnDestroyイベントを用意します。

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  FVMI := TVirtualMethodInterceptor.Create(TPushButtonActionLink);
  FVMI.OnAfter :=
    procedure(Instance: TObject; Method: TRttiMethod;
              const Args: TArray<TValue>; var Result: TValue)
    begin
    if Method.Name = 'Execute' then
    begin
      ActiveControl := nil;
    end;
  end;

  for I := 0 to ControlCount - 1 do
  begin
    if Controls[I] is TButton then
    begin
      FVMI.Proxify(TButton(Controls[I]).GetActionLink);
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ControlCount - 1 do
  begin
    if Controls[I] is TButton then
    begin
      PPointer(TButton(Controls[I]).GetActionLink)^ := FVMI.OriginalClass;
    end;
  end;
  FVMI.Free;
end;

フォームのOnDestroyイベントでProxifyしたVMT(OriginalClass)を元に戻しています。うまくいきましたね。

それではDelphi XE2で追加されたUnproxifyを使う方法を。

procedure TForm1.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ControlCount - 1 do
  begin
    if Controls[I] is TButton then
    begin
      FVMI.Unproxify(TButton(Controls[I]).GetActionLink);
    end;
  end;
  FVMI.Free;
end;

フォームのOnDestroyイベントでUnproxifyするだけで基本的に同じです。こちらも問題なく動作しました。

2012年2月17日

Visualizing using FireMonkeyシリーズ

エンバカデロ・テクノロジーズのAnders OhlssonさんによるFireMonkeyで数式をビジュアル化する"Visualizing using FireMonkey"シリーズ(勝手に命名)が翻訳されています。

そういえばJim TierneyさんのLiveBindingチュートリアルの3本目(http://blogs.embarcadero.com/jimtierney/2011/10/14/31608)が翻訳されてないのは元記事がednにあがっていない(blogにのみある)から、とのこと。

2012/03/27追記: C++(C++Builder XE2)を使った記事2本のリンクを追加しました。

2012年2月15日

Microsoft Monthly Update 2012/02

今日はMicrosoftのセキュリティアップデートの日です。
MS12-008
MS12-009
MS12-010
MS12-011
MS12-012
MS12-013
MS12-014
MS12-015
MS12-016

2012年2月9日

例外チェーン

Delphi 2009の新機能の一つに例外チェーン、あるいはネストした例外オブジェクトというものがあります。従来の(Delphi 2007およびそれ以前の)例外処理では、発生した例外をtry...except文で捕捉した場合に、そのままendに到達することで例外処理を終了させるか、別の例外オブジェクトを生成して送出することで例外処理をさらに上位に向かって継続するか、例外を再生成("raise;")することで例外処理を継続するか、のいずれかになります。しかし、別の例外を送出する場合は元の例外オブジェクトの持つ情報は消滅してしまいますし、例外を再生成する場合は新たな情報を付け加えることができません。そこでこの例外チェーンという機能を使うことで、元の例外オブジェクトの持つ情報に新たな情報を加えて上位の処理に送出することができます。

例として、あるテキストファイルの1行目に書かれている文字列を10進数とみなして取り込む、という関数を考えてみます。

type
  EFileIsEmpty = class(Exception);

function ReadIntegerValueFromFile(const Path: String): Integer;
var
  Filename: String;
  SL: TStringList;
begin

  Filename := IncludeTrailingPathDelimiter(Path) + 'FOO.TXT';
  SL := TStringList.Create;
  try
    SL.LoadFromFile(Filename);
    if SL.Count = 0 then
    begin
      raise EFileIsEmpty.Create('File is empty.');
    end;

  Result := StrToInt(SL.Strings[0]);

  finally
    SL.Free;
  end;

end;

ここで例外が送出される状況には、1.何らかの理由でファイルを開けない(EFOpenError)、2.ファイルが空(0行)だった(EFileIsEmpty)、3.1行目に10進数に変換できない文字があった(EConvertError)の3つがあります(正確にはリソース不足でTStringList.Createが失敗する状況を含め4つですが、今回は考えないことにします)。それぞれの原因に対応した例外クラスがあるため、呼び出し元ではエラーの理由を例外オブジェクトのクラスの違いで知ることができます。

procedure TForm1.Button1Click(Sender: TObject);
begin

  try
    ReadIntegerValueFromFile('C:\BAR');

  except
    on E: EFOpenError do
    begin
      MessageDlg('ファイルを開けませんでした。' + sLineBreak + E.Message,
                 mtInformation,[mbOk],0);
      Exit;
    end;

    on E: EFileIsEmpty do
    begin
      MessageDlg('ファイルが空でした。' + sLineBreak + E.Message,
                 mtInformation,[mbOk],0);
      Exit;
    end;

    on E: EConvertError do
    begin
      MessageDlg('不正な文字列が入っていました。' + sLineBreak + E.Message,
                 mtInformation,[mbOk],0);
      Exit;
    end;
  end;

end;

ここでエラーメッセージにファイル名を表示したい、ということになったとします。ところが呼出元のレベルではファイルの存在するパスはわかっていますがフルパス名はReadIntegerValueFromFileの内部に隠蔽されてしまっています。そこで

type
  EFileIsEmpty = class(Exception);
  EFileReadError = class(Exception)
  private
    FFilename: String;
  public
    constructor Create(const Msg: string; const AFilename: String);
    property Filename: String read FFilename;
  end;

function ReadIntegerValueFromFile(const Path: String): Integer;
var
  Filename: String;
  SL: TStringList;
begin

  Filename := IncludeTrailingPathDelimiter(Path) + 'FOO.TXT';
  SL := TStringList.Create;
  try
    try
      SL.LoadFromFile(Filename);
      if SL.Count = 0 then
      begin
        raise EFileIsEmpty.Create('File is empty.');
      end;
      Result := StrToInt(SL.Strings[0]);

    except
      raise EFileReadError.Create('Error!',Filename);
    end;

  finally
    SL.Free;
  end;

end;

constructor EFileReadError.Create(const Msg, AFilename: String);
begin

  inherited Create(Msg);

  FFilename := AFilename;

end;

とすることで

procedure TForm1.Button1Click(Sender: TObject);
begin

  try
    ReadIntegerValueFromFile('C:\BAR');

  except
    on E: EFileReadError do
    begin
      MessageDlg(Format('ファイル ''%s'' の読み込みでエラーが発生しました。' + 
                        sLineBreak  + '%s',
                        [E.Filename,E.Message]),
                 mtInformation,[mbOk],0);
      Exit;
    end;
  end;

end;

のようにエラーがあったときにそのファイルのフルパス名を知ることができます。が、エラーの原因はわからなくなってしまいました。そこで例外チェーンの登場です。クラスプロシージャException.RaiseOuterExceptionを使用することで、その例外ハンドラで受け取った例外オブジェクトを消滅させることなく新たな例外を送出することができます。

type
  EFileIsEmpty = class(Exception);
  EFileReadError = class(Exception)
  private
    FFilename: String;
  public
    constructor Create(const Msg: string; const AFilename: String);
    property Filename: String read FFilename;
  end;

function ReadIntegerValueFromFile(const Path: String): Integer;
var
  Filename: String;
  SL: TStringList;
begin

  Filename := IncludeTrailingPathDelimiter(Path) + 'FOO.TXT';
  SL := TStringList.Create;
  try
    try
      SL.LoadFromFile(Filename);
      if SL.Count = 0 then
      begin
        raise EFileIsEmpty.Create('File is empty.');
      end;
      Result := StrToInt(SL.Strings[0]);

    except
      Exception.RaiseOuterException(EFileReadError.Create('Error!',Filename));
    end;

  finally
    SL.Free;
  end;

end;

constructor EFileReadError.Create(const Msg, AFilename: String);
begin

  inherited Create(Msg);

  FFilename := AFilename;

end;

ここで送出される例外オブジェクトはEFileReadErrorのままです。しかし

procedure TForm1.Button1Click(Sender: TObject);
begin

  try
    ReadIntegerValueFromFile('C:\BAR');

  except
    on E: EFileReadError do
    begin
      if E.InnerException is EFOpenError then
      begin
        MessageDlg(Format('ファイル ''%s'' を開けませんでした。' + 
                          sLineBreak + '%s',
                          [E.Filename,E.InnerException.Message]),
                   mtInformation,[mbOk],0);
      end
      else if E.InnerException is EFileIsEmpty then
      begin
        MessageDlg(Format('ファイル ''%s'' が空でした。' + 
                          sLineBreak + '%s',
                          [E.Filename,E.InnerException.Message]),
                   mtInformation,[mbOk],0);
      end
      else if E.InnerException is EConvertError then
      begin
        MessageDlg(Format('ファイル ''%s'' の1行目に不正な文字列が入っていました。' + 
                          sLineBreak + '%s',
                          [E.Filename,E.InnerException.Message]),
                   mtInformation,[mbOk],0);
        Exit;
      end;

      Exit;
    end;
  end;

end;

と例外オブジェクトのInnerExceptionプロパティでException.RaiseOuterExceptionを呼び出した時点での例外オブジェクトを参照することができます。

この例外チェーンに関係するメソッド、プロパティには

RaiseOuterException: 例外ブロック内で使用し、新しく生成した例外オブジェクトをパラメータとして呼び出すことでその時点での例外オブジェクトをチェーンした例外を送出するExceptionクラスのクラスプロシージャ。
ThrowOuterException: RaiseOuterExceptionと同じ。C++では例外はraiseするものではなくthrowするものなのでこの名前のクラスプロシージャも用意されている。
InnerException: 最も近いRaiseOuterExceptionを送出した時点での例外オブジェクトを格納しているプロパティ。通常の例外の送出(raise EXXXX.Create)ではnilとなる。またRaiseOuterExceptionがネストして呼び出されている場合はE.InnerException.InnerException...のようにさかのぼって例外オブジェクトを参照することができる。
BaseException: ネストしてRaiseOuterExceptionが呼び出された場合に最初に送出された例外オブジェクトを格納しているプロパティ。通常の例外の送出(raise EXXXX.Create)ではnilとなる。また1段階しかRaiseOuterExceptionが呼び出されていない場合はInnerException=BaseExceptionとなる。
ToString例外チェーン上の全ての例外オブジェクトのMessageプロパティをCR+LFで連結したプロパティ。

があります。

元ねたはDELPHI 2009 HANDBOOK。

2012年2月2日

[書籍]世界一わかりやすいSQLの授業

同じくMARUZEN&ジュンク堂書店渋谷店で

世界一わかりやすいSQLの授業 (amazon)/Lepton著/ソシム/ISBN 978-4-88337-801-2/2,079円

を購入。

[書籍]Clean Coder

MARUZEN&ジュンク堂書店渋谷店でThe Clean Coderの翻訳である

Clean Coder (amazon)/Robert C. Martin著/角征典訳/アスキー・メディアワークス/ISBN 978-4-04-886069-7/2,100円

を購入。プロフェッショナルなプログラマ(またはそれを目指す人)は読んでおくべきです。

2012年2月1日

第21回エンバカデロ・デベロッパーキャンプ開催決定

第21回エンバカデロ・デベロッパーキャンプは2012年03月09日~2012年03月10日の2日間で開催されます。

エンバカデロ・デベロッパーキャンプ
【3/9～10】第21回エンバカデロ・デベロッパーキャンプ

今回は全セッションオンラインで中継あり、懇親会あり、そして宿泊ありと盛り沢山で行われます。

2012/02開催のウェブセミナー

2012/02/15 17:00-18:00(JST) 2/15 - デベロッパーTV - 「デブサミ直前 – RAD Studio XE2」
- Replay (1/2)
- Replay (2/2)

2012/02/23追記: リプレイビデオのリンクを追加しました。

登録: 投稿 (Atom)

Owl's perspective