RAD Studio/Delphi/C++Builder XE Help Update 2

予告されていたRAD Studio/Delphi/C++Builder XEのHelp Update 2がリリースされています。

Delphi XE および C++Builder XE 向け Help Update 2
28256 Help Update 2 for Delphi XE and C++Builder XE

元ねたはTeam Japan » Delphi XE, C++Builder XE, RAD Studio XE向けの「ヘルプアップデート2」。

2011/03/28追記: EDNの記事のリンクを追加。

Firebird 3の初期レビュー

Firebird ProjectのリードアーキテクトのDmitry YemanovさんによるFirebird 3の初期レビューのスライドショーが公開されています。

Initial review of Firebird 3

Firebird 3で実装したいと考えられている機能がいろいろと挙げられています。またリリーススケジュールについても言及されています。

• 2.0.7 - 2011年のQ2-Q3
• 2.1.5 - 2012年
• 2.5.1 - 2011年のQ2
• 3.0 Alpha - 2011年のQ3

元ねたはFirebird News » Initial review of Firebird 3 – Presentation。

Firebird 2.1.4リリース

Firebird Ver2.1.4がリリースされています。

Firebird File Repositories(download)
Firebird 2.1.4 Release Notes

更新が減ります

状況が安定していないため、当面の間更新が減ります。ニュース的なものはおそらくお伝えしていきますが、Tips的なものはしばらくお休みになると思います。

地震

とりあえず周囲では人的被害はありませんが、岩手県、宮城県、福島県、茨城県方面は大変なことになっているようです。

22:35 帰宅なう。23kmに4時間。そして帰ったとたんにTVのテロップに京王線復旧の情報ががが。

RAD Studio/Delphi/C++Builder XE Help Update 2準備中

Dee EllingさんによるとRAD Studio/Delphi/C++Builder XE Help Update 2が近日中にリリースされるようです。Help Update 2における変更点は

Readme - Help Update 2 for Delphi and C++Builder XE - RAD Studio
リリース ノート： Delphi XE および C++Builder XE Help Update 2 - RAD Studio

で確認することができます(日本語版は準備中)。

元ねたは公式フォーラムのEmbarcadero Discussion Forums: XE Help Update 2 Sneak Peek。

2011/03/16追記: 日本語版のリリースノートのリンクを追加しました。

Microsoft Monthly Update 2011/03

今日はMicrosoftのセキュリティアップデートの日です。
MS11-015
MS11-016
MS11-017

IInterfaceをTObjectにキャストする

Delphi 2010以降ではIInterfaceからasで任意のクラスにキャストすることが可能になりましたが、それ以前のバージョンでIInterfaceからTObjectにキャストを行う方法についてのBarry KellyさんとHallvard Vassbotnさんによる記事。興味深い。とりあえずメモ。

Entropy Overload: An ugly alternative to interface to object casting
Hallvard's Blog: Hack #7: Interface to Object [in The Delphi Magazine]

どちらの記事のコードも基本的には同じで、IInterfaceからvtable(仮想メソッドテーブル)を参照し、最初のエントリにあるスタブメソッドのコードの中にあるオフセットを取得してIInterface(これは実際にはポインタ)に加算することでインスタンスのアドレスを取得する、というハックになっています。

RAD Studio/Delphi/C++Builder XE Hotfix

RAD Studio/Delphi/C++Builder XEのHotfixがリリースされています。

Delphi XE, C++Builder XE, RAD Studio XE 向けHotfix

ひとつはInterBase/Firebird DBXドライバがftMemoのフィールドを2回読むとAVになる問題への対応で、Pro SKUとEnt/Arc SKUで別のHotfixになっています。

28249 RAD Studio XE Hotfix for RAID 280988 (QC 89242) - Pro
28248 RAD Studio XE Hotfix for RAID 280988 (QC 89242) - Arch and Ent

もうひとつはTClientDataSetとTProviderの組み合わせでデータベースサーバからマイナス値のステータスコードを受け取るとエラーになる問題の対応で、こちらはEnt/Arc SKUのみPro/Ent/Arc SKU共通です。

28247 RAD Studio XE Hotfix for RAID 280864 (QC 88928)

2011/03/06追記: EDNの日本語版の記事が出たのでリンクを差し替えました。週末なのにご苦労さまです。

2011/03/27追記: Team Japanの

Team Japan » RAD Studio XE Hotfix for QC 88928は、Pro版にも適用可能です

によるとQC 88928のHotfix(28247)はPro SKUにも適用する必要があるとのことです。

エンバカデロ・デベロッパーキャンプツアー・イン名古屋/大阪 2011開催

2011年03月02日～03日に名古屋と大阪でエンバカデロ・デベロッパーキャンプツアー・イン名古屋 2011とエンバカデロ・デベロッパーキャンプツアー・イン大阪 2011が開催されました。残念ながらUStream中継などはなかったのですが(せめて配布資料のダウンロードだけでも…配布資料のダウンロードは第19回エンバカデロ・デベロッパーキャンプの後になるとか。あだちさん、情報ありがとうございます)、参加された方からの情報がいくつか。

Togetter - 「デベロッパーキャンプ ツアー イン 名古屋＆大阪」

藤井さんのフライト遅延でヒヤヒヤ、ツアーイベントに向けてNigel来日と名古屋イベント無事終了、いざ大阪へ！

月夜ヶ丘さんの[Embarcadero] デベロッパーキャンプツアー in 名古屋

2011/04/07追記: セッション資料がダウンロードできるようになっています。

第19回 エンバカデロ・デベロッパーキャンプ - セッション資料ダウンロード

[書籍]体系的に学ぶ 安全なWebアプリケーションの作り方

紀伊國屋書店 渋谷店で

体系的に学ぶ 安全なWebアプリケーションの作り方 (amazon)/徳丸浩著/ソフトバンククリエイティブ/ISBN 978-4-7973-6119-3/3,360円

を購入。

Windowsにおける呼出規約の歴史

Raymond ChenさんのThe Old New ThingにWindowsにおける呼出規約(Calling Convention)とその歴史的経緯に関するアーティクルがありました。

The history of calling conventions, part 1 - The Old New Thing - Site Home - MSDN Blogs
Part 1では16bit環境での規約(C/Pascal/Fortran/Fastcall)について説明しています。16bit環境ではどの規約でもBP、SI、DIの内容は保持される必要があり、戻値はAX(16bit)またはDX:AX(32bit)に格納します。

The history of calling conventions, part 2 - The Old New Thing - Site Home - MSDN Blogs
Part 2では過去に存在した32bitのx86以外のCPU(Alpha AXP/MIPS R4000/PowerPC)の規約について説明しています。これらのCPUでは呼出規約が1つずつしかありません。またRISC系CPUでレジスタが多く存在するため、スタックをなるべく使わないようになっています。

The history of calling conventions, part 3 - The Old New Thing - Site Home - MSDN Blogs
Part 3ではx86(32bit)の規約(C/__stdcall/__fastcall/thiscall)について説明しています(Microsoftのものだけですが)。どの規約でもEDI、ESI、EBP、EBXの内容は保持される必要があり、EDX:EAXレジスタペアに戻値を格納します。なおC++のメンバ関数ではthisポインタが暗黙の第1パラメータとなることに注意が必要です。またWin32APIは基本的に__stdcallです。(参考: Results of Calling Example)

The history of calling conventions, part 4: ia64 - The Old New Thing - Site Home - MSDN Blogs
Part 4ではia64(Intel Itanium)の規約について説明しています。ia64には呼出規約は1つしかありません。ia64には128のレジスタがあり、グローバルに使用する32(r0-r31)を除いたローカル領域の96(r32-r127)について、関数はレジスタをいくつローカル/パラメータで使用するのかを宣言するようになっており、可能であればレジスタ間のシフト(実際にはレジスタリネーミングでしょう)で、もし必要であれば専用のレジスタスタックを使用するようになっています(解釈が違ったらすいません)。戻値はグローバル領域のレジスタ経由で呼び出し元に返され、リターンアドレスも通常はローカル領域のレジスタ上に置かれます。興味深いのはスタック上の最初の16バイトは誰がいつどのように使ってもいい(=関数を呼び出したら内容が破壊されているかもしれない)領域となっていることと、ia64上の関数ポインタは関数のエントリポイントではなく関数記述構造体(a structure that describes the function)を指しており、構造体の前半8バイトがエントリポイント、次の8バイトが"gpレジスタ"の値を格納するようになっているということでしょうか(関数ポインタがエントリポイントではなくある種の構造体を指すというのはRISC系CPUと共通しています)。

The history of calling conventions, part 5: amd64 - The Old New Thing - Site Home - MSDN Blogs
Part 5ではx64(AMD64)の規約について説明しています。
てきとうな要約:

• x64ではx86のレジスタが64bitに拡張されており(RAX、RBX、...)、さらにR8-R15の8つのレジスタが追加されています。
• x64についても呼出規約は1つしかありません。
• 最初の4つのパラメータはRCX、RDX、R8、R9に格納され、それ以降はスタックに配置されますが、スタック上には最初の4つのパラメータの分の領域も確保されます。
• パラメータが64bit未満の場合、上位ビットを0にするのではなくごみ("garbage")のままとなり、64bitよりも大きいパラメータはその格納アドレスが渡されます。
• 戻値はRAXに格納されますが、64bitよりも大きい場合は第1パラメータとして戻値を格納する領域のアドレスが渡されます。
• RAX、RCX、RDX、R8、R9、R10、R11以外のレジスタの内容は保持される必要があります。
• スタックのクリーンアップは呼出元の責任です。
• スタックは16バイトアライメントで維持されます。

Delphi(x86)の呼出規約については

Procedures and Functions (Delphi) - RAD Studio
プロシージャと関数 - RAD Studio

に説明があります。またx64については日本語だとAkihiro NotesさんのMicrosoft x64 呼び出し規約の説明がわかりやすいですね。

x64プログラミングの参考資料

次期版のDelphi "Pulsar"では従来の32bit版Windows(x86)に加えて64bit版Windows(x64)とMacOS X(x86)のサポートが追加される予定です。Windows x64に関しては既にMicrosoftのVisual Studio (Visual C++)がサポートしていますが、Microsoftによるx64プログラミングの解説がMSDNにありました。

x64 の入門書: 64 ビット Windows システムのプログラミングを開始するときに必要な知識 -- MSDN Magazine, 2006 年 5 月
Visual C++ による 64 ビット プログラミング
64 ビット Windows プログラミング ガイド (Windows)

x86とx64の大きな違いは

• データサイズ(32/64bit)
• 呼出規約(calling convention)
• 例外処理(SEH)

でしょうか(細かい話ではPE32+ヘッダやprintfの書式指定などもありますが)。これらの記事は"Pulsar"でも十分に役立つと思います。

64bit版Windowsでシステムキャッシュが物理メモリを使い切ってしまう現象

Firebird Newsに

Firebird slow? Well, maybe it is Windows fault.

という記事がありました。FirebirdをWindows x64(XP/Server 2003/Vista/Server 2008)で動作させると処理がスローダウンする場合があり、

You experience performance issues in applications and services when the system file cache consumes most of the physical RAM
Too Much Cache? - Ntdebugging Blog - Site Home - MSDN Blogs

にあるようにシステムキャッシュが物理メモリを使い切ってしまう(物理メモリの最大90%をシステムが占有してしまい、残りの10%の物理メモリしかアプリケーションで使用できない)現象が存在する、という話です(原因はFirebirdとは全く無関係)。日本語だと

リソース不足について – 番外編1 (64bit 環境での注意点) - Ask CORE - Site Home - TechNet Blogs

あたりが詳しいのですが、対策としてはアプリケーション側からGetSystemFileCacheSize/SetSystemFileCacheSizeを使用してワーキングセットの上限値を制限する必要があります。またこれをサービスとして制御する

Microsoft Windows Dynamic Cache Service

というものを利用する方法もあります(むしろこちらが本命)。

なおWindows 7/Server 2008R2ではメモリ管理関係が設計から見直されていてこの問題は存在しないとのことです。

TFileStreamのコンストラクタで指定するアクセスモードについて

Delphiでファイルを扱うときによく使うTFileStream (ja)のコンストラクタCreate (ja)の第2パラメータModeと、WindowsのAPIであるCreateFile (ja)の第2パラメータdwDesiredAccess、第3パラメータdwShareMode、第5パラメータdwCreationDispositionの関係を調べてみました。

まずModeに指定できる値としてfm...の定義値を調べてみます。fmCreateのみがClasses.pasに

  fmCreate = $FFFF;

(Classes.pasの53行目)(Delphi 2007の場合、以下同じ)

と定義され、その他の値はSysUtils.pasに

  fmOpenRead       = $0000;
  fmOpenWrite      = $0001;
  fmOpenReadWrite  = $0002;

  fmShareCompat    = $0000 platform; // DOS compatibility mode is not portable
  fmShareExclusive = $0010;
  fmShareDenyWrite = $0020;
  fmShareDenyRead  = $0030 platform; // write-only not supported on all platforms
  fmShareDenyNone  = $0040;

(SysUtils.pasの44行目付近)

と定義されています。…fmCreateが0xFFFFで他の定義値が16bitの定数ということは、ModeにfmCreateを指定した場合、その他の指定は一切意味を持たない、ということになりますね。実際にTFileStream.Createを見てみると、

constructor TFileStream.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
  begin
  if Mode = fmCreate then
  begin
  ...
  end
  else
  begin
  ...
  end;
  FFileName := AFileName;
end;

(Classes.pasの5474行目付近)

と、確かにModeがfmCreateかそれ以外かで完全に処理が分けられてしまっています。ではfmCreateのケースをさらに追ってみます。

inherited Create(FileCreate(AFileName, Rights));

(Classes.pasの5478行目)

とSysUtils.pas上のFileCreate (ja)を呼び出しています(inherited CreateはTFileStreamの派生元であるTHandleStream (ja)のコンストラクタ呼び出しです)。FileCreateは

Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));

(SysUtils.pasの5259行目付近)

という実装であり、結果としてfmCreateの場合、dwDesiredAccessはGENERIC_READ or GENERIC_WRITE、dwShareModeは0(Prevents other processes from opening a file or device if they request delete, read, or write access.=他の処理からは削除、読み込み、書き込みアクセスできない)、dwCreationDispositionはCREATE_ALWAYS(新しいファイルを作成します。指定したファイルが既に存在している場合、そのファイルを上書きし、既存の属性を消去します。)と、これらの値が固定的に指定される、ということになります。

一方fmOpen...の場合、

inherited Create(FileOpen(AFileName, Mode));

(Classes.pasの5484行目)

とSysUtils.pas上のFileOpen (ja)を呼び出しています。FileOpenは

const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
   FILE_SHARE_READ or FILE_SHARE_WRITE);
  ...
  Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
    ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0));

(SysUtils.pasの5196行目付近)

という実装で、dwDesiredAccessはfmOpenRead→GENERIC_READ、fmOpenWrite→GENERIC_WRITE、fmOpenReadWrite→GENERIC_READ or GENERIC_WRITEとマップされ、dwShareModeはfmShareCompat/fmShareExclusive→0(他の処理からは削除、読み込み、書き込みアクセスできない)、fmShareDenyWrite→FILE_SHARE_READ(他の処理からは読み込みアクセスのみ許可)、fmShareDenyRead→FILE_SHARE_WRITE(他の処理からは書き込みアクセスのみ許可)、fmShareDenyNone→FILE_SHARE_READ or FILE_SHARE_WRITE(他の処理からは読み込み、書き込みアクセスとも許可)とマップされ、dwCreationDispositionはOPEN_EXISTING(ファイルを開きます。指定したファイルが存在していない場合、この関数は失敗します。)が固定的に指定される、ということになります。

これ以外の組み合わせ、たとえば書き込みのために新規にファイルを作成(存在していたら上書き)し、そのファイルに読み込みアクセスのみ許可する、というような場合(dwDesiredAccess = GENERIC_READ or GENERIC_WRITE、dwShareMode = FILE_SHARE_READ、dwCreationDisposition = CREATE_ALWAYS)はTFileStreamを使用するのではなく、直接Windows APIのCreateFileをこれらのパラメータで呼び出し、取得したファイルハンドルでTHandleStreamを作成する、という処理が必要になります。例えばこんな感じでしょうか。

procedure HandleStreamSample(const AFilename: String);
var
  FileHandle: Integer;
  Stream: THandleStream;
begin

  FileHandle := CreateFile(PChar(AFilename),GENERIC_READ or GENERIC_WRITE,
                           FILE_SHARE_READ,nil,CREATE_ALWAYS,
                           FILE_ATTRIBUTE_NORMAL,0);
  if FileHandle < 0 then
  begin
    raise EFCreateError.CreateResFmt(@SFCreateErrorEx,[ExpandFileName(AFileName),
                                     SysErrorMessage(GetLastError)]);
  end;

  Stream := THandleStream.Create(FileHandle);
  try
    { Streamに対する処理 }

  finally
    Stream.Free;
  end;

end;

あるいはCreateFileの他のパラメータ、例えば第6パラメータにFILE_FLAG_...を指定したいような場合などもこのようなコーディングが必要になります。

RAD Studio/Delphi/C++Builder XE付属のFinalBuilder/AQtimeのアップデート

RAD Studio/Delphi/C++Builder XEにバンドルされているFinalBuilderとAQtimeがアップデートされ、FinalBuilder Embarcadero Edition(Ent/Arc SKUのみ)が7.0.0.992に、AQtime 7 Standard for Embarcadero RAD Studio XE(Pro/Ent/Arc SKUのみ)が7.10になっています。

AQtime and FinalBuilder Updates for Delphi XE, C++Builder XE and RAD Studio XE
28231 FinalBuilder for Delphi, C++Builder and RAD Studio XE
28230 AQtime 7.1 Standard for Delphi, C++Builder and RAD Studio XE

FinalBuilder 7 Version History

Bug Fixes in AQtime 7.10
New Features in AQtime 7.10

Project "Cooper"

2011年02月08日からLas Vegasで行われたDeveloper Solutions Conference (DSConf)でRemObjectsがJava版のDelphi Prism(Oxygene)ともいえるProject "Cooper"を発表しています。

DSConf in Review « RemObjects Blogs

現在RAD Studioに含まれているDelphi Prism("Oxygene")は.NET上で動作するObject Pascal環境ですが、Project "Cooper"はJava(JVM)/Android(Dalvik)上で動作するObject Pascal環境、ということのようです。開発環境はVisual StudioかMonoDevelopに統合されます。詳しくはプレビュービデオで。

YouTube - Project "Cooper" Preview

ただしOxygeneのいくつかの機能、例えば(.NETに強く依存する)LINQのようなものは含まれません。リリースは今年(2011年)で、それ以上のことは今は言えない(That's all we can really say,for now)、とのことです。

ちなみにYouTubeのビデオの最初に出てきますが、"Cooper"は懐かしのツイン・ピークスのクーパー特別捜査官(FBI Special agent Dale Cooper)から取られたそうです。

元ねたはフォーラムのThread: Cooper。

関係ありませんが、ここ1日くらいフォーラムのサーバ(forums.embarcadero.com)が不安定のような気がします。

Delphiの特定バージョン以前/以後の判定を行う

ライブラリや共通コードを記述していると、DelphiのコンパイラやRTL/VCLの特定の機能が実装されているかどうかを判定して処理を分けたい、ということがよくあります。Delphi 2009のUnicode対応を示す標準条件シンボルの"UNICODE"のように

{$IFDEF UNICODE}
// String = UnicodeString (Delphi 2009 or later)
{$ELSE}
// String = AnsiString (Delphi 2007 or earlier)
{$ENDIF}

とできれば簡単なのですが、Windows.pasのTTokenInformationClassの新しい定義や無名メソッド (ja)のサポートのように実装を示す標準条件シンボルの定義が存在しないものは単純に$IFDEFで判定できません。そこでDelphi 6で導入されたCONDITIONALEXPRESSIONSとRTLVersion/CompilerVersionを組み合わせて判定してみます。

Windows.pasにおけるTTokenInformationClassの定義はDelphi 2009(Ver20)で拡張されました。これはRTLの問題ですから、

{$IF (NOT DEFINED(CONDITIONALEXPRESSIONS)) OR (RTLVersion < 20.0)}
// Delphi 2-5 or 6-2007
{$ELSE}
// Delphi 2009 or later
{$IFEND}

で判定可能です(判定を逆にしたい場合はドモルガンの法則により

{$IF (DEFINED(CONDITIONALEXPRESSIONS)) AND (RTLVersion >= 20.0)}

とする)。

一方、Delphi 2010(Ver21)で言語仕様に追加されたクラスコンストラクタとクラスデストラクタについてはコンパイラの問題ですから、

{$IF (NOT DEFINED(CONDITIONALEXPRESSIONS)) OR (CompilerVersion < 21.0)}
// Class constructor/destructor is invalid
{$ELSE}
// Class constructor/destructor is valid
{$IFEND}

として判定することで、Delphi 2009およびそれ以前ではクラスコンストラクタ (ja)/クラスデストラクタ (ja)の代わりにinitialization部 (ja)/finalization部 (ja)で処理を処理を行う、といったことが可能になります。

なお$IFDEFは$ENDIFで閉じますが、$IFは$IFENDで閉じる、という点に注意が必要です。

UAC(User Account Control)の状態を取得する

Windows Vistaで導入されたUAC(User Account Control)が有効になっているかどうかはレジストリのHKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\SystemのEnableLUA(DWORD値)が0かどうかで判断できます(0はUAC無効、1はUAC有効)。一方でUACが有効のときにそのプロセスが管理者権限に昇格しているかどうかはOpenProcessToken (ja)でカレントプロセスのハンドルからアクセストークンを取得し、GetTokenInformation (ja)でTokenInformationClassにTokenElevationを指定して取得したTOKEN_ELEVATION構造体のTokenIsElevatedが0かどうかで判断できます(0は昇格していない、非0は昇格している)。

まずプロセスが管理者権限に昇格しているかどうかを判定する処理です。Windows.pasのTTokenInformationClassのTokenElevationやTOKEN_ELEVATION構造体の定義はDelphi 2009で追加されたものなので、それ以前のバージョンでは独自に定義する必要があります。

{$IF (NOT DEFINED(CONDITIONALEXPRESSIONS)) OR (RTLVersion < 20.0)}
type
  TTokenInformationClass = (TokenUser = 1,
                            TokenGroups,
                            TokenPrivileges,
                            TokenOwner,
                            TokenPrimaryGroup,
                            TokenDefaultDacl,
                            TokenSource,
                            TokenType,
                            TokenImpersonationLevel,
                            TokenStatistics,
                            TokenRestrictedSids,
                            TokenSessionId,
                            TokenGroupsAndPrivileges,
                            TokenSessionReference,
                            TokenSandBoxInert,
                            TokenAuditPolicy,
                            TokenOrigin,
                            TokenElevationType,
                            TokenLinkedToken,
                            TokenElevation,
                            TokenHasRestrictions,
                            TokenAccessInformation,
                            TokenVirtualizationAllowed,
                            TokenVirtualizationEnabled,
                            TokenIntegrityLevel,
                            TokenUIAccess,
                            TokenMandatoryPolicy,
                            TokenLogonSid,
                            MaxTokenInfoClass);
  {$EXTERNALSYM TTokenInformationClass}

  PTokenElevation = ^TTokenElevation;
  _TOKEN_ELEVATION = record
    TokenIsElevated: DWORD;
  end;
  {$EXTERNALSYM _TOKEN_ELEVATION}
  TTokenElevation = _TOKEN_ELEVATION;
  TOKEN_ELEVATION = _TOKEN_ELEVATION;
  {$EXTERNALSYM TOKEN_ELEVATION}

function GetTokenInformation(TokenHandle: THandle;
                             TokenInformationClass: TTokenInformationClass;
                             TokenInformation: Pointer;
                             TokenInformationLength: DWORD;
                             var ReturnLength: DWORD): BOOL; stdcall;
  external advapi32 name 'GetTokenInformation';
{$EXTERNALSYM GetTokenInformation}
{$IFEND}

function IsProcessTokenElevated(ProcessHandle: THandle): Boolean;
var
  TokenHandle: THandle;
  TE: TOKEN_ELEVATION;
  dwLength: DWORD;
begin

  Result := False;

  if OpenProcessToken(ProcessHandle,TOKEN_QUERY,TokenHandle) = False then
  begin
    Exit;
  end;

  try
    if GetTokenInformation(TokenHandle,TokenElevation,
                           @TE,SizeOf(TE),dwLength) = False then
    begin
      Exit;
    end;

  finally
    CloseHandle(TokenHandle);
  end;

  Result := (TE.TokenIsElevated <> 0);

end;

これを使用して、レジストリの値をチェックし、UACが有効ならIsProcessTokenElevatedで管理者権限に昇格しているかどうかを確認します。

type
  TUACStatus = (usNoUAC,           // UAC is not implemented
                usUACDisabled,     // UAC is disabled
                usUACEnabled,      // UAC is enabled
                usUACRunAsAdmin);  // UAC is enabled and process token is elevated

function GetUACStatus: TUACStatus;
var
  ReadValue: Integer;
begin

  Result := usNoUAC;

  if CheckWin32Version(6,0) = False then
  begin
    // Windows 2000 or XP: UAC is not implemented
    Exit;
  end;

  with TRegistry.Create do
  begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly('\Software\Microsoft\Windows\CurrentVersion\Policies\System') = False then
      begin
        raise ERegistryException.Create('Error: Cannot open registry key.');
      end;

      try
        ReadValue := ReadInteger('EnableLUA');
        if ReadValue = 0 then
        begin
          Result := usUACDisabled;
        end
        else
        begin
          Result := usUACEnabled;
        end;

      finally
        CloseKey;
      end;

    finally
      Free;
    end;
  end;

  if Result = usUACEnabled then
  begin
    if IsProcessTokenElevated(GetCurrentProcess) = True then
    begin
      Result := usUACRunAsAdmin;
    end;
  end;

end;

GetUACStatusの戻値がusUACEnabledの場合、REGEDITのように実行時に管理者権限を要求するプロセスを起動するときにUACの確認ダイアログが開くことになります(usNoUAC/usUACDisabledならUACは動作せず、usUACRunAsAdminなら既に昇格済なので確認されない)。

UACが有効かどうかとプロセスが昇格しているかは別々に取得するようにしたほうがいいのかもしれませんが、UAC有効でなければプロセスの昇格も起きないので、ここでは1つにまとめました。

元ねたはDisplay UAC Status - Sysinternals Forums - Page 1とEternalWindowsのセキュリティ / セキュリティコンテキスト / UAC。

Microsoft Monthly Update 2011/02

今日はMicrosoftのセキュリティアップデートの日です。
MS11-003
MS11-004
MS11-005
MS11-006
MS11-007
MS11-008
MS11-009
MS11-010
MS11-011
MS11-012
MS11-013
MS11-014