IDE製品に同梱のInterBase(Local/Developer Edition)に関するまとめ

Delphiには開発用にInterBaseが同梱されていますが、どのバージョンがどのプロダクトに含まれているのかをまとめてみました。

Local InterBase Server 4.1

最新アップデート: (n/a)

プロダクト: Delphi 2

対応OS: Windows 95/NT 4.0

制限事項: ローカル接続のみ

参照URL: (n/a)

Local InterBase Server 4.2.1

最新アップデート: (n/a)

プロダクト: Delphi 3/3.1

対応OS: Windows 95/NT 4.0

制限事項: ローカル接続のみ

参照URL: (n/a)

InterBase 5.0

最新アップデート: (n/a)

プロダクト: C++Builder 3/Delphi 4

対応OS: Windows 95/NT 4.0

制限事項: Local InterBaseライセンスのみ

参照URL: (n/a)

InterBase 5.6

最新アップデート: (n/a)

プロダクト: Delphi 5/C++Builder 5

対応OS: Windows 95/98/NT4(SP5)

制限事項: Local InterBaseライセンスのみ

参照URL: (n/a)

InterBase 6

最新アップデート: (n/a)

プロダクト: Delphi 6/7/C++Builder 6

対応OS: Windows 98SE/Me/NT 4.0(SP6a)/2000(SP1)

制限事項: Local InterBaseライセンスのみ

参照URL: (n/a)

InterBase 7.1

最新アップデート: Service Pack 2 + Security update

プロダクト: Delphi 2005

対応OS: Windows 98/Me/NT 4.0(SP6a)/2000(SP2)/XP/Server 2003(IB7.1 SP2)

制限事項: IDE製品がインストール済かつ許諾済であること？

参照URL: (n/a)

InterBase 7.5

最新アップデート: 7.5.1 Service Pack 1

プロダクト: Developer Studio 2006/JBuilder 2006

対応OS: Windows 2000(SP4)/XP Pro(SP2)/Server 2003(SP1)

制限事項: IDE製品がインストール済かつ許諾済であること(特に設定を行わないとサービスとしては起動しない)

参照URL: InterBase 7.5 Developer の起動について

InterBase 2007

最新アップデート: Service Pack 3

プロダクト: RAD Studio 2007

対応OS: Windows 2000(SP4)/XP(SP2)/Server 2003/Vista

制限事項: 最大48時間までしか連続稼動できない

参照URL: InterBase 2007 Developer Editionの仕様について

InterBase 2009

最新アップデート: Hotfix Update 4

プロダクト: RAD Studio 2009

対応OS: Windows 2000(SP4)/XP(SP2)/Server 2003/Vista/Server 2008

制限事項: 最大48時間までしか連続稼動できない？

InterBase XE

最新アップデート: Update 5

プロダクト: ?

対応OS: Windows XP(SP3)/Vista(x86/x64)/Server 2008/7(x86)/Server 2008 R2

制限事項: 最大48時間までしか連続稼動できない、4coreまでのサポート、20同時接続ユーザ(80コネクション)

InterBase XE3

最新アップデート: Update 1

プロダクト: RAD Studio XE3

対応OS: Windows XP(SP3)/Vista(x86/x64)/Server 2008/7(x86/x64)/Server 2008 R2/8(x86/x64)/Server 2012

制限事項: 最大48時間までしか連続稼動できない、4coreまでのサポート、20同時接続ユーザ(80コネクション)

2011/01/06追記: InterBase 2009/XEの情報を更新しました。

2012/12/31追記: InterBase XEの情報を更新し、InterBase XE3の情報を追加しました。

日本法人代表交代

旧Borland日本法人のIDE部門分社化以来の責任者でエンバカデロ・テクノロジーズ合同会社(いわゆる日本法人)の代表(職務執行者)の八重樫さんが退任され、替わって藤井さんが日本法人の代表になる、というニュースが飛び込んできました。海の向こうはハッピーホリデーの休暇に入るところ(そして日本も年内は後3日)というタイミングでの発表(非公式ですけど)はちょっと驚きです(年内に、ということであれば最後のタイミングですが)。
八重樫さんとは2回ほどお話をさせていただきましたが、見た目とは違い(見た目通り？)、優しく気さくな方でした(敵にしたら恐ろしい、かも…)。次はどのようなことをされるのでしょうか？ご活躍をお祈りしています。

[書籍]Delphi 2009 Handbook/Delphi 2009 Development Essentials

Marco CantuさんのDelphi 2009 HandbookがLulu.comから到着。Bob SwartさんのDelphi 2007 for Win32 Development EssentialsとDelphi 2009 Development Essentialsも一緒に買ったのでまとめて積んだ。

Delphi 2009/C++Builder 2009 Help Update 1

Delphi 2009/C++Builder 2009のHelp Update 1がリリースされています。
リリースノート： Delphi 2009 および C++Builder 2009 Help Update 1

Dee Ellingさんによれば、CHM/PDF/HTML版がEmbarcadero CodeGear Product Documentation SITE BETAに載るのは来年になるようです。あちらはもうホリデーシーズンですしね。

2011/05/04追記: codegear.comのリンクをembarcadero.comのものに差し替え。

DBX4 BDE Driver

Team Japan » DBX4 BDE Driver
興味深い。後日追記予定(?)。

Microsoft OOB Update 2008/12

Microsoftの定例外のセキュリティアップデートがリリースされています。
MS08-078

ファイルサイズを取得する(2)

前回のファイルサイズの取得の方法ではNTFSログファイルが一杯になると取得できるファイルサイズがファイルの更新に従って変化しなくなるという不具合を避けることができません。そこでこのKBのworkaroundに従ってWin32APIのGetFileSizeExを使用してファイルサイズを取得する方法です。

function GetFileSizeEx(hFile: THandle; var lpFileSize: LARGE_INTEGER): BOOL; stdcall;
  external kernel32 name 'GetFileSizeEx';

function GetFileSize(const Filename: String; var FileSize: Int64): Boolean;
var
  Handle: THandle;
  LI: LARGE_INTEGER;
begin

  Result := False;

  FileSize := 0;
  Handle := Windows.CreateFile(PChar(Filename),GENERIC_READ,0,nil,
                               OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if Handle = INVALID_HANDLE_VALUE then
  begin
    Exit;
  end;

  try
    if GetFileSizeEx(Handle,LI) = False then
    begin
      Exit;
    end;

  finally
    Windows.CloseHandle(Handle);
  end;

  FileSize := LI.LowPart or (Int64(LI.HighPart) shl 32);
  Result := True;

end;

GetFileSizeExがオープン済のファイルハンドルを要求するため、CreateFileで一旦ファイルをオープンし、ファイルサイズ取得後にクローズするようにしています。このためアクセス権などの問題からオープンに失敗するようなファイルのサイズを取得することができません。

Delphi 2009/C++Builder 2009 Update 2

Delphi 2009/C++Builder 2009のUpdate 2がリリースされています。Update 2はデータベース関係のアップデートのみとのことです。また事前にUpdate 1を適用しておく必要があります。
リリースノート： Delphi 2009 および C++Builder 2009 Update 2
List of Bug Fixes in Update 2 for Delphi and C++Builder 2009

InterBase 2007 Service Pack 3リリース

InterBase 2007 SP3 for Windows - Japaneseがダウンロードできるようになっています。
InterBase 2007 Service Pack 3 (8.1.1.333) リリースノート

2008/12/16追記: InterBase 2007 SP3はSP2適用済の環境にのみ適用可能です(SP2の詳細についてはこちら)。

スプラッシュフォームを表示する

メインフォームを表示するのに時間がかかる(データベースを参照していたり、大きなファイルを読み込む必要があったり、理由はさまざまでしょうけれども)ようなときに、スプラッシュフォームを表示することでこれをごまかす、じゃなくて目立たなくするという方法があります。
まず表示に時間がかかるメインフォームとしてこのようなものを考えます。

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin

  for I := 0 to 99 do
  begin
    Sleep(100);
  end;

end;

起動からメインフォームの表示まで10秒かかります(あたりまえ)。
ここでスプラッシュ用のフォームを用意します。必要に応じてプロパティを指定したりLabelやPanelやImageなどを配置してそれなりの体裁を整えていただくとして、ここで必要なイベントハンドラはOnDeactivateです。OnDeactivateイベントハンドラではReleaseメソッドを呼び出してスプラッシュフォーム自身を解放するようにします。

type
  TForm2 = class(TForm)
    procedure FormDeactivate(Sender: TObject);
  end;

procedure TForm2.FormDeactivate(Sender: TObject);
begin

  Release;

end;

さらにスプラッシュフォームを表示するためのメソッドを用意します。このスプラッシュフォームには通常の(メッセージループ経由の)メッセージが全く送られない(アプリケーションのメッセージループが動作し始めると直後にOnDeactivateが発生する)ので、Updateメソッドで強制的に表示更新を行う必要があります。

procedure ShowSplashForm;
begin

  with TForm2.Create(nil) do
  begin
    Show;
    Update;
  end;

end;

そしてこのメソッドをプロジェクトソース内のApplication.Initializeの後で呼び出します。

begin

  Application.Initialize;

  ShowSplashForm;

  Application.CreateForm(TForm1, Form1);
  Application.Run;

end.

Delphi 2007以降ではWindows Vista対応のためにApplicationとメインフォームの関係を色々と変更したために

begin

  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  ShowSplashForm;

  Application.CreateForm(TForm1, Form1);
  Application.Run;

end.

とApplication.MainFormOnTaskbarの設定の後にスプラッシュフォームを表示するようにする必要があります(逆にDelphi 2006以前ではTForm2の所属ユニットのinitialization部で十分なのですが)。
Applicationの初期化後にまずスプラッシュフォームが生成、表示され、メインフォームが生成されて時間がかかる処理が走り、Apprication.Runでメインフォームが表示されてアクティブになることでスプラッシュフォームはインアクティブになり、OnDeactivateイベントが発生してスプラッシュフォームが消滅する、という動作の流れになります。

Microsoft Monthly Update 2008/12

今日はMicrosoftのセキュリティアップデートの日です。
MS08-070
MS08-071
MS08-072
MS08-073
MS08-074
MS08-075
MS08-076
MS08-077

InterBase SMP 2009 Develper Edition 日本語版リリース

InterBase SMP 2009のDeveloper Edition 日本語版がダウンロードできるようになっています。
InterBase SMP 2009 Developer Edition日本語版および追加プラットフォーム版のダウンロード

Delphi 2009 Whitepapers

Marco CantuさんによるDelphi 2009 White Paperがリリースされています。
White Paper #1 Unicode: White Paper: Delphi and Unicode
White Paper #2 Language: White Paper: Using New Delphi Coding Styles and Architectures
White Paper #3 The IDE: White Paper: A Tour of Delphi 2009
White Paper #4 The VCL: White Paper: Building User Interfaces with Delphi 2009
White Paper #5 Datasnap 2009: White Paper: The New DataSnap in Delphi 2009

#2の表紙に著者名が入っていないのは単なるミスだそうです。

2008/12/16追記: #3がリリースされています。
2009/01/22追記: #4がリリースされています。
2009/01/28追記: #5がリリースされています。

OpenTools API入門

あとで読む。
Extending Delphi 2009 With OpenTools API: Getting Started

OTA(OpenTools API)はDelphi/C++BuilderのIDEとインタフェースするためのAPIで、wizardやpluginはこれを利用して作成します。

第11回エンバカデロ・デベロッパーキャンプ終了

参加者および関係者の皆さん、おつかれさまでした。
ところで会場に来てたのはMalcolm Grovesさんでしたか。
また後で更新予定…。

2008/12/06追記: ITProにMalcolm Grovesさんのインタビュー記事が。

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

Delphi 2009 Handbook出版

Marco CantuさんのDelphi 2009 HandbookがLulu.comから出版されました。全400ページで、価格は48.50USD(約4500円)ですが、先着60名は40.50USD(これは既に終了)、CodeRage IIIの期間中(2008/12/05まで)は45.50USD(約4200円)のディスカウントが設定されています。

2008/12/04追記: ソースコードがCodeCentralからダウンロードできるようになっています。

2008/12/05再追記: Delphi 2009/C++Builder 2009/RAD Studio 2009登録ユーザはPDF eBook形式のものをCodeGearから入手できるようになりました。
Delphi 2009 Handbook PDF eBook

また「何らかの形で日本語版を出せるように交渉中」という話をデベロッパーキャンプで藤井さんがしていましたので、期待してます。

2009/05/22再追記: Marco Cantuさんによると、Amazon(US)の傘下でプリントオンデマンドを扱うCreateSpaceという会社からも入手可能になったそうです。
Delphi 2009 Handbook on Amazon.com

2011/05/04追記: cc.codegear.comのリンクをcc.embarcadero.comのものに差し替え。

IDE Fix Pack 2.1リリース

Andreas HausladenさんのIDE Fix Pack 2007/2009がアップデートしてVersion 2.1になっています。
IDE Fix Pack 2.1 and DFMCheck 1.3

IDE Fix Pack and VCL Fix Pack

IDE/VCLのBugFixが進まないことにAndreas Hausladenさんが業を煮やしたらしく、IDE/VCLの非公式パッチ集であるIDE Fix Pack 2009とVCL Fix Packをリリースしています。
IDE Fix Pack 2.0 and VCL Fix Pack 1.0 released

IDE Fix PackにはDelphi/C++Builder 2007用もあります。またVCL Fix PackはDelphi 6以降に適用可能なようです(先日の非公式パッチも含まれています)。

3rdRail and TurboRuby

CodeGear(Embarcadero)から3rdRail 2.0とTurboRubyが発表されています。
Press Release: Embarcadero Ships Latest Edition of 3rdRail™ and Introduces TurboRuby IDEs

気になる3rdRail SKUとTurboRuby SKUの違いですが、FAQ FAQによればRailsフレームワークのサポートの有無(TurboRubyはRailsフレームワークをサポートしない)のようです。
ということは。
あくまで個人的な意見ですが、噂のDelphi/C++BuilderのTurbo SKUも、IDEは同じだけれどもVCLというフレームワームをサポートしない、という路線なのでは？と考えています。

2011/05/04追記: codegear.comのリンクをembarcadero.comのものに差し替え。

マニフェストのrequestExecutionLevelに指定できる値

Windows Vista上で管理者権限を要求するアプリケーションを作成するで説明したアプリケーションマニフェスト上のrequestExecutionLevelのlevel属性に指定できる値とその意味は以下のようになっています。

requireAdministrator

アプリケーションはAdministrator権限で開始されなければならず、それ以外の権限では実行されない。

highestAvailable

アプリケーションはログオンアカウントで要求できる最も高い権限で開始されなければならない。ログオンユーザがAdministratorアカウントならば権限昇格のプロンプトが表示されたうえでAdministrator権限で開始され、標準ユーザアカウントならば(権限昇格のプロンプトの表示なしに)標準の権限で開始される。

asInvoker

アプリケーションは呼び出し元のアプリケーションと同じ権限で開始される。

元ねたはAdvanced Windows 第5版 上 p.142

2008/11/20追記: ついでにGetProcessElevation関数(p.146)を移植してみようと思ったけど、Windows 2000ではGetTokenInformationにTokenElevationTypeを渡すとパラメータエラーになることが判明して断念。難しい…。

Delphi 2009/C++Builder 2009非公式パッチ群

DelphiSpeedUpやDDevExtensionsで有名なAndreas HausladenさんがDelphi 2009/C++Builder 2009の非公式パッチを4点公開しています。
QC66892 Form.Hide/Close - Stack tashing bugfix unit 元記事
QC59963 Application De/Activate bugfix unit (2007/2009) 元記事
QC68740 TOpen/SaveDialog focus bugfix unit (2007/2009) 元記事
IDE Fix Pack 1.0 for RAD Studio 2009 元記事

アプリケーションの多重起動を禁止する

プログラムの性質によっては多重起動を禁止したいことがあります。このようなときには同期オブジェクトの一つであるmutexを使用します。

Delphiのプロジェクトソースを開くとこのようになっています。

program Project1;

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

{$R *.res}

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

ここで一意な名前のmutexをプログラム実行中だけ作成(CreateMutex)し、もしその名前のmutexが存在していたらプログラムを終了、存在していなければ実行を継続し、プログラム終了時にはmutexを破棄(CloseHandle)するコードを追加します。

program Project1;

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

{$R *.res}

const
  { Mutex name }
  CMutexName: String = '{9D0E11F8-ED24-4D3E-91B1-5E9A9BF8673A}';

var
  hMutex: THandle;
begin

  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  { Create mutex }
  SetLastError(0);
  hMutex := CreateMutex(nil,False,PChar(CMutexName));
  if hMutex = 0 then
  begin
    RaiseLastOSError;
  end;

  try
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      Exit;
    end;

    Application.CreateForm(TForm1, Form1);
    Application.Run;

  finally
    { Close mutex }
    CloseHandle(hMutex);
  end;

end.

これでプログラムの多重起動を禁止することができます。
作成するmutexの名前は任意(上記の例では適当にGUIDを生成して使用しています)ですが、'Global\'と'Local\'で始まるmutex名には特別な意味があるので注意が必要です(詳細はCreateMutex参照)。また同名のmutexが存在するかどうかを調べるのにOpenMutexを使用するとOpenMutexの呼び出しからCreateMutexの呼び出しまでの間が無防備になってしまうため、CreateMutexの第2パラメータbInitialOwnerにFalseを指定して呼び出し後、GetLastErrorの値がERROR_ALREADY_EXISTSかどうかで判定するようにします。

さらにアプリケーションのメインウィンドウを前面に移動し、最小化も解除するようにしてみます。

program Project1;

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

{$R *.res}

const
  { Mutex name }
  CMutexName: String = '{9D0E11F8-ED24-4D3E-91B1-5E9A9BF8673A}';

var
  hMutex: THandle;
  Wnd: HWnd;
  AppWnd: HWnd;
begin

  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  { Create mutex }
  SetLastError(0);
  hMutex := CreateMutex(nil,False,PChar(CMutexName));
  if hMutex = 0 then
  begin
    RaiseLastOSError;
  end;

  try
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      { Search main form }
      Wnd := FindWindow(PChar('TForm1'),nil);  // Class name of the main form
      if Wnd = 0 then
      begin
        Exit;
      end;

      { Bring foreground and activate }
      SetForegroundWindow(Wnd);

      { Get window handle of TApplication }
      AppWnd := GetWindowLong(Wnd,GWL_HWNDPARENT);
      if AppWnd <> 0 then
      begin
        Wnd := AppWnd;
      end;

      { Restore if iconized }
      if IsIconic(Wnd) then
      begin
        SendMessage(Wnd,WM_SYSCOMMAND,SC_RESTORE,-1);
      end;

      Exit;
    end;

    Application.CreateForm(TForm1, Form1);
    Application.Run;

  finally
    { Close mutex }
    CloseHandle(hMutex);
  end;

end.

Delphiのウィンドウコントロールはクラス名がそのままウィンドウクラス名になるため、FindWindowにはアプリケーションのメインフォームのクラス名を渡します。

Microsoft Monthly Update 2008/11

今日はMicrosoftのセキュリティアップデートの日です。
MS08-068
MS08-069

Delphi/C++Builder 2009 Japanese Hotfix 1

IDEの環境オプションのタイプライブラリの設定がエラーになる件(QC68044)のHotfixがリリースされています。事前にUpdate 1を適用しておく必要があるとのことです。
Team Japan » Delphi/C++Builder 2009 Japanese Hotfix 1

2008/11/12追記: C++Builder 2009ではdelphicompro120.jpは必要ないとのことです。

Delphi 2009/C++Builder 2009 Update 1

Delphi 2009/C++Builder 2009のUpdate 1がリリースされています。
Delphi and C++Builder 2009 Update 1 リリースノート
Delphi 2009 および C++Builder 2009 Update 1 バグフィックスリスト

Delphi Prism

PDCにあわせてDelphi.NETの次期版であるDelphi PrismがCodeGearからアナウンスされています(まとめのwikiページもあり (ja))。現時点でわかっていることを羅列してみます。

• Microsoft Visual Studio Shell上で動作する。


• コンパイラはRemObjectのOxygeneを使用する。


• C#には実装されていないいくつかの機能(Parallel Loops,Inline Property Accessors,Class Contracts,Extended Constructor Calls,Boolean Double Comparisonなど)をサポートする。


• Monoを使用することでLinuxやMac OS X上でも動作する。

さぁどうなることやら。

2008/10/28追記: 手回しのよいことで、Delphi Prism FAQページもできています。

2008/11/04再追記: あれ？ネタ元はどこだっけな…。1週間で忘れてしまった…。

2011/05/04追記: codegear.comのリンクをembarcadero.comのものに差し替え。

第11回エンバカデロ・デベロッパーキャンプ

第11回エンバカデロ・デベロッパーキャンプは2008年12月03日開催です。

Microsoft OOB Update 2008/10

Microsoftの定例外のセキュリティアップデートがリリースされています。
MS08-067

Delphi 2009 Handbook

Marco CantuさんによればDelphi 2009 Handbookの作業が進行中だそうです。
Lulu.comから2008/11出版予定、44.50USD(約4500円)とのこと。
ちなみにDelphi 2007 Handbookもお勧めです。

Microsoft Monthly Update 2008/10

今日はMicrosoftのセキュリティアップデートの日です。
MS08-056
MS08-057
MS08-058
MS08-059
MS08-060
MS08-061
MS08-062
MS08-063
MS08-064
MS08-065
MS08-066
KB956391 (Cumulative Security Update of ActiveX Kill Bits)

[書籍]Advanced Windows 第5版

Advanced Windowsの第5版が出るらしい(2008/10/23 2008/10/27予定)。

Advanced Windows 第5版 上/Jeffrey Richter, Christophe Nasarre著/(株)クイープ訳/日経BPソフトプレス/ISBN 978-4-89100-592-4/5,775円
Advanced Windows 第5版 下/Jeffrey Richter, Christophe Nasarre著/(株)クイープ訳/日経BPソフトプレス/ISBN 978-4-89100-593-9/5,985円

問題は、値段はともかく、第4版が積まれたままになっているということか…。

2008/10/22追記: 日経BPソフトプレスによると発行日は2008/10/27とのことなので修正。

2008/11/04再追記: 2008/10/24に買って積んだ。読む時間がほしい。

NTFSファイル圧縮機能を利用する(3)

NTFSで使用することができるファイル圧縮機能をプログラムから利用する方法の第三弾です。
フォルダの圧縮属性をセット/リセットしても、そのフォルダに新規に作成するファイルのデフォルトの属性として適用されるだけで、既存のファイルには影響が及びません。そこで指定されたフォルダとそのサブフォルダ、含まれる全てのファイルをトラバースして圧縮属性をセット/リセットするようにします。
フォルダ/ファイルに圧縮属性を適用するたびにコールバック関数を呼び出して進行状況が呼び出し元に通知されるようになっています。コールバックが不要な場合はnilを指定してください。またDelphi 2009ではコールバックに新機能の無名メソッドを使用するようにしてみました。

uses
  Windows, SysUtils;

{$IFDEF VER200}
{$DEFINE ANONYMOUSMETHOD}  // Anonymous method is available on Delphi 2009 or later
{$ENDIF}

type
  { Callback function declaration }
  TNotifyCompressFunc = {$IFDEF ANONYMOUSMETHOD} reference to {$ENDIF}
    procedure (const Filename: String;
               Operation: TCompressOperation
               {$IFNDEF ANONYMOUSMETHOD}; Param: DWORD {$ENDIF});

procedure CompressDirectory(const Dirname: String;
                            Operation: TCompressOperation;
                            IgnoreError: Boolean;
                            CallbackFunc: TNotifyCompressFunc
                            {$IFNDEF ANONYMOUSMETHOD}; Param: DWORD{$ENDIF});

{ Forward declarations }
procedure InternalCompressDirectory(const Dirname: String;
                                    Operation: TCompressOperation;
                                    IgnoreError: Boolean;
                                    CallbackFunc: TNotifyCompressFunc
                                    {$IFNDEF ANONYMOUSMETHOD}; Param: DWORD{$ENDIF}); forward;

{$WARN SYMBOL_PLATFORM OFF}

procedure CompressDirectory(const Dirname: String;
                            Operation: TCompressOperation;
                            IgnoreError: Boolean;
                            CallbackFunc: TNotifyCompressFunc
                            {$IFNDEF ANONYMOUSMETHOD}; Param: DWORD{$ENDIF});
var
  Attr: DWORD;
  Path: String;
begin

  if VolumeCanCompress(Dirname) = False then
  begin
    { This volume is not support compression }
    Exit;
  end;

  Path := ExcludeTrailingPathDelimiter(Dirname);

  { Get directory attributes }
  Attr := GetFileAttributes(PChar(Path));
  if Attr = $FFFFFFFF then
  begin
    RaiseLastOSError;
  end;

  { Compress or decompress directory }
  InternalCompressDirectory(IncludeTrailingPathDelimiter(Dirname),Operation,
                            IgnoreError,CallbackFunc
                            {$IFNDEF ANONYMOUSMETHOD},Param{$ENDIF});

  { Compress or decompress }
  if NeedChangeCompression(Operation,Attr) = True then
  begin
    if Assigned(CallbackFunc) then
    begin
      CallbackFunc(Path,Operation{$IFNDEF ANONYMOUSMETHOD},Param{$ENDIF});
    end;

    try
      InternalCompressFile(Path,Operation,Attr);

    except
      if IgnoreError = False then
      begin
        raise;
      end;
    end;
  end;

end;

procedure InternalCompressDirectory(const Dirname: String;
                                    Operation: TCompressOperation;
                                    IgnoreError: Boolean;
                                    CallbackFunc: TNotifyCompressFunc
                                    {$IFNDEF ANONYMOUSMETHOD}; Param: DWORD{$ENDIF});
var
  SR: TSearchRec;
  Path: String;
begin

  if FindFirst(Dirname + '*.*',faAnyFile,SR) = 0 then
  begin
    try
      repeat
        { Skip current and parent directory }
        if (SR.Name = '.') or (SR.Name = '..') then
        begin
          Continue;
        end;

        Path := Dirname + SR.Name;

        { Compress or decompress directory (recursive call) }
        if (SR.Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0 then
        begin
          InternalCompressDirectory(IncludeTrailingPathDelimiter(Path),
                                    Operation,IgnoreError,CallbackFunc
                                    {$IFNDEF ANONYMOUSMETHOD},Param{$ENDIF});
        end;

        { Compress or decompress }
        if NeedChangeCompression(Operation,SR.Attr) = True then
        begin
          if Assigned(CallbackFunc) then
          begin
            CallbackFunc(Path,Operation{$IFNDEF ANONYMOUSMETHOD},Param{$ENDIF});
          end;

          try
            InternalCompressFile(Path,Operation,SR.Attr);

          except
            if IgnoreError = False then
            begin
              raise;
            end;
          end;
        end;

      until FindNext(SR) <> 0;

    finally
      FindClose(SR);
    end;
  end;

end;

{$WARN SYMBOL_PLATFORM ON}

パラメータIgnoreErrorは、Explorerで開いているフォルダを(圧縮属性を適用するために)CreateFileでオープンしたときにエラーになるため、これを無視するためのものです。
Delphi 2007およびそれ以前のバージョンでは以下のように呼び出します(フォーム上にButton1/Edit1/CheckBox1/Label1を配置)。

procedure CallbackFunc(const Filename: String; Operation: TCompressOperation; Param: DWORD);
begin
  TForm1(Param).Label1.Caption := 'Compressing: ' + Filename;
  TForm1(Param).Refresh;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompressDirectory(Edit1.Text,coCompress,CheckBox1.Checked,
                    CallbackFunc,DWORD(Self));
 Label1.Caption := 'Finished.';
end;

これに対してDelphi 2009の無名メソッドを使用する場合は以下のように呼び出します。

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompressDirectory(Edit1.Text,coCompress,CheckBox1.Checked,
    procedure(const Filename: String; Operation: TCompressOperation)
    begin
      Label1.Caption := 'Compressing: ' + Filename;
      Refresh;
    end);
  Label1.Caption := 'Finished.';
end;

同じ内容の無名メソッドの使いまわしを考えるのであれば、こんな風にします。

function MakeCallbackFunc(Form: TForm1): TNotifyCompressFunc;
begin
  Result := 
    procedure(const Filename: String; Operation: TCompressOperation)
    begin
      case Operation of
        coCompress:
        begin
          Form.Label1.Caption := 'Compressing: ' + Filename;
        end;

        coDecompress:
        begin
          Form.Label1.Caption := 'Decompressing: ' + Filename;
        end;
      end;

      Form.Refresh;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompressDirectory(Edit1.Text,coCompress,CheckBox1.Checked,
                    MakeCallbackFunc(Self));
  Label1.Caption := 'Finished.';
end;

元ねたはNTFSの圧縮機能 - HEROPA's HomePageやサンプルプログラム集　ファイルの圧縮属性の変更あたり。

NTFSファイル圧縮機能を利用する(2)

NTFSで使用することができるファイル圧縮機能をプログラムから利用する方法の第二弾です。
ファイル/フォルダの圧縮属性をセット/リセットするにはCreateFileでファイル/フォルダをオープンし、DeviceIoControlでFSCTL_SET_COMPRESSIONを指定します。

uses
  Windows, SysUtils;

type
  { Compress operation }
  TCompressOperation = (coCompress, coDecompress);

const
  FSCTL_SET_COMPRESSION      = $0009C040;
  COMPRESSION_FORMAT_NONE    = $00000000;
  COMPRESSION_FORMAT_DEFAULT = $00000001;

procedure InternalCompressFile(const Filename: String;
                               Operation: TCompressOperation;
                               Attr: DWORD); forward;
function  NeedChangeCompression(Operation: TCompressOperation;
                                Attr: DWORD): Boolean; forward;

{$WARN SYMBOL_PLATFORM OFF}

procedure CompressFile(const Filename: String; Operation: TCompressOperation);
var
  Attr: DWORD;
begin

  if VolumeCanCompress(Filename) = False then
  begin
    { This volume is not support compression }
    Exit;
  end;

  { Get file attributes }
  Attr := GetFileAttributes(PChar(Filename));
  if Attr = $FFFFFFFF then
  begin
    RaiseLastOSError;
  end;

  if NeedChangeCompression(Operation,Attr) = True then
  begin
    { Compress or decompress }
    InternalCompressFile(Filename,Operation,Attr);
  end;

end;

procedure InternalCompressFile(const Filename: String;
                               Operation: TCompressOperation;
                               Attr: DWORD);
const
  CompressionFormat: array [TCompressOperation] of DWORD =
                       (COMPRESSION_FORMAT_DEFAULT,  // Compress by default format
                        COMPRESSION_FORMAT_NONE);    // Decompress
var
  Handle: THandle;
  InBuffer: DWORD;
  BytesReturned: DWORD;
  Access: DWORD;
  Flags: DWORD;
begin

  { Flags for CreateFile }
  Access := GENERIC_READ or GENERIC_WRITE;
  if (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0 then
  begin
    Flags  := FILE_ATTRIBUTE_NORMAL;
  end
  else
  begin
    Flags  := FILE_FLAG_BACKUP_SEMANTICS;
  end;

  { Reset read-only attribute }
  if (Attr and FILE_ATTRIBUTE_READONLY) <> 0 then
  begin
    SetFileAttributes(PChar(Filename),Attr and not FILE_ATTRIBUTE_READONLY);
  end;

  try
    { Open file or directory }
    Handle := CreateFile(PChar(Filename),Access,0,nil,OPEN_EXISTING,Flags,0);
    if Handle = INVALID_HANDLE_VALUE then
    begin
      RaiseLastOSError;
    end;

    try
      { Compress or decompress }
      InBuffer := CompressionFormat[Operation];
      Win32Check(DeviceIoControl(Handle,FSCTL_SET_COMPRESSION,
                                 @InBuffer,SizeOf(InBuffer),
                                 nil,0,BytesReturned,nil));

    finally
      { Close }
      CloseHandle(Handle);
    end;

  finally
    { Restore read-only attribute }
    if (Attr and FILE_ATTRIBUTE_READONLY) <> 0 then
    begin
      SetFileAttributes(PChar(Filename),
                        GetFileAttributes(PChar(Filename)) or
                        FILE_ATTRIBUTE_READONLY);
    end;
  end;

end;

function NeedChangeCompression(Operation: TCompressOperation;
                               Attr: DWORD): Boolean;
begin

  Result := ((Ord(Operation) xor
              Ord((Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0)) = 0);

end;

{$WARN SYMBOL_PLATFORM ON}

ファイル/フォルダをオープンするときはCreateFileでdwDesiredAccessにGENERIC_READ or GENERIC_WRITEを、dwCreationDispositionにOPEN_EXISTINGを、それぞれ指定する必要があります。また対象がフォルダのときはdwFlagsAndAttributesにFILE_FLAG_BACKUP_SEMANTICSを指定します。さらにファイル/フォルダの属性に書込禁止(FILE_ATTRIBUTE_READONLY)が含まれている場合はSetFileAttributesで一時的に解除する必要もあります。
元ねたはNTFSの圧縮機能 - HEROPA's HomePageやサンプルプログラム集　ファイルの圧縮属性の変更あたり。

NTFSファイル圧縮機能を利用する(1)

NTFSで使用することができるファイル圧縮機能をプログラムから利用する方法の第一弾です。
そのボリュームでNTFSファイル圧縮機能を使用できるかどうかはGetVolumeInformationでFileSystemFlagsを取得し、FS_FILE_COMPRESSIONが含まれているかどうかで判定します。

uses
  Windows, SysUtils;

{$WARN SYMBOL_PLATFORM OFF}

function VolumeCanCompress(const Filename: String): Boolean;
var
  MaximumComponentLength: DWORD;
  FileSystemFlags: DWORD;
  RootPath: String;
begin

  { Get root path }
  RootPath := IncludeTrailingPathDelimiter(ExtractFileDrive(Filename));

  { Get volume information }
  Win32Check(GetVolumeInformation(PChar(RootPath),nil,0,nil,
                                  MaximumComponentLength,FileSystemFlags,
                                  nil,0));

  { Check FS_FILE_COMPRESSION flag }
  Result := ((FileSystemFlags and FS_FILE_COMPRESSION) <> 0);

end;

{$WARN SYMBOL_PLATFORM ON}

元ねたはNTFSの圧縮機能 - HEROPA's HomePageなど。

レジストリのデータをエクスポートする

Windowsのレジストリに書き込んだ設定をファイルにエクスポートするには

REGEDIT.EXE /e "<exportfile>" "<keyname>"
<exportfile> ... 出力ファイル名(拡張子.REG)
<keyname> ... 出力する最上位のキー名(HKEY_CURRENT_USER\...)

を実行します。Windows Vistaではレジストリエディタ(REGEDIT.EXE)がUACで管理者権限を要求するため、管理者として実行する必要があります。

Delphi/C++Builder 2009に同梱のInstallAwareについて

Delphi/C++Builder 2009に同梱のInstallAwareがInstallAware Express 6 CodeGear Special Editionのままでした。これはちょっと…。IAの現行バージョンは8なんですけど。

2008/12/05追記: DEKOさんのご指摘 DEKOさんのご指摘のとおりで、DVDの \InstallAware\ia-codegear-express-special-edition.exe がInstallAware 7 CodeGear Special Edition (InstallAware Express CodeGear Special Edition. Based on InstallAware 7 Release 2 (Build babiali_r2.070408)、Version 7.9.7201.2008、英語版)になっています。なおインストーラをローカライズしたいときなどもDEKOさんのちっぷす DEKOさんのちっぷすが非常に役に立ちます。それにしてもどこかの会社で日本語にローカライズして販売してくれませんかね？

Delphi 2009のUnicodeサポート(日本語訳)

Nick HodgesさんのUnicodeサポート関連の記事の日本語訳が公開されています。
Delphi Unicodeワールド パートI: Unicodeとは？ なぜ必要なのか？ そして、Delphiでどのような作業を行うのか？
Delphi Unicodeワールド パートII: RTLの新機能と、Unicodeをサポートするクラス
Delphi Unicodeワールド パートIII: コードをUnicode対応にする

2008/09/17追記: パートII/IIIのリンクを追加しました。

2010/08/27追記: リンクをcodegear.comからembarcadero.comのものに差し替えました。

2010/09/28追記: パート1のリンク先が変更されたので修正しました。

DataSnap 2009

あとで読む。
DataSnap 2009 概要
DataSnap 2009のメモリー管理
DataSnap 2009のスレッドモデル

DataSnapってなにそれ？おいしいの？状態だけど。

2008/09/26追記:
C++BuilderにおけるDataSnap 2009のサポートについて

Microsoft Monthly Update 2008/09

今日はMicrosoftのセキュリティアップデートの日です。
MS08-052
MS08-053
MS08-054
MS08-055

第10回エンバカデロ・デベロッパーキャンプ(東京)終了

参加者の皆さんおつかれさまでした。関係者の皆さんはまだ明後日(大阪)があるので頑張ってくださいね。
さて、公開されてNDAから外れた重要情報を。
1.Turbo Explorer SKUについては考慮中。ただし機能は削って『言語の習得に絞った』ものにする(言語というのはこの場合C++/Object Pascalを指すと思われる)。つまり現状のTurbo Explorerとはかなり異なったものになるのでは？
2.Delphi.NETは次のRAD Studio(年内リリース？)には含まれる。その後はMicrosoft Visual Studioのプラグインとして.NET Framework 3.5の対応も含め.NETの全機能に対応していきたい。ただしRAD Studioのパーソナリティではなくなる。
それからロードマップ上Tiburonの次になるCommodoreは2009年3Q-4Qになりそうです(今までの情報よりは若干後退)。64bit対応以外にもマルチタスク/マルチスレッドサポートなどを盛り込むかどうかを検討中とのこと。

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

2008/09/25再追記: Nick Hodgesさんのテクニカルセッションのビデオも公開されています。
ビデオ - Delphi 2009 / C++Builder 2009最新情報

2008/10/01再々追記: Nick Hodgesさんのジェネラルセッションのビデオも公開されました。
ビデオ - CodeGearプロダクトアップデート

2011/05/04追記: dn.codegear.comのリンクをedn.embarcadero.comのものに差し替え。

Welcome to Japan, Nick

Nick Hodgesさんがオーストラリアからはしごで来日されたようです(来たのは昨日かな？)。早速お仕事のようで。
DelphiとC++Builderの“再活性化”に向けて、エンバカデロが新版をアピール

標準条件シンボル

標準条件シンボル Delphiで予め定義済のシンボルを標準条件シンボル(standard conditional symbols)と呼び、以下のようなものがあります。

VER<nnn>
コンパイラバージョン
RTLVersion<nnnn>
ランタイムマイナーバージョン(仮)(Delphi 10.4.2以降)
DCC
(全ての環境で定義)
CONSOLE
コンソールアプリケーション
NATIVECODE
ネイティブコード(Delphi.net以降の.NET環境以外で定義)
MSWINDOWS
Windows(Kylix/macOS/iOS/Android/Linux以外で定義)
WIN32
Windows x86環境で定義(Delphi 6以降)
WIN64
Windows x64環境で定義(Delphi XE2以降)
MACOS
MacOS環境で定義(Delphi XE2以降)
MACOS32
MacOS 32bit環境で定義(Delphi XE2以降)
MACOS64
MacOS 64bit環境で定義(Delphi XE8以降)
OSX
OSX(MacOS)環境で定義(Delphi 11以降)
OSX64
OSX(MacOS)環境で定義(Delphi 11以降)
POSIX
MacOSを含むPOSIX環境で定義(Kykix/Delphi XE2以降)
POSIX32
MacOSを含むPOSIX 32bit環境で定義(Kykix/Delphi XE2以降)
POSIX64
MacOSを含むPOSIX 64bit環境で定義(Delphi XE2以降)
IOS
iOS(デバイス/シミュレータ)環境で定義(Delphi XE4以降)
IOS32
iOS 32bit環境で定義(Delphi XE8以降)
IOS64
iOS 64bit環境で定義(Delphi XE8以降)
LINUX
Linux環境で定義(Kylix/Delphi 10.2以降)
LINUX32
Linux 32bit環境で定義(Kylix/Delphi 10.2以降)
LINUX64
Linux 64bit環境で定義(Delphi 10.2以降)
ANDROID
Android環境で定義(Delphi XE5以降)
ANDROID32
Android 32bit環境で定義(Delphi XE8以降)
ANDROID64
Android 64bit環境で定義(Delphi 10.3.3以降)
CLR
.NET環境で定義
CPU386
i386以降のCPU
CPUX86
x86のCPU(Delphi XE2以降)
CPUX64
x64のCPU(Delphi XE2以降)
CPUXARM
ARMのCPU(Delphi XE4以降)
CPUARM32
32bit版ARMのCPU(Delphi XE8以降)
CPUARM64
64bit版ARMのCPU(Delphi XE8以降)
CPU32BITS
32bitのCPU(Delphi XE8以降)
CPU64BITS
64bitのCPU(Delphi XE8以降)
ASSEMBLER
アセンブラ構文(asm)を使用できるかどうか
UNICODE
Unicode環境で定義(Delphi 2009以降)
CONDITIONALEXPRESSIONS
条件評価($IF指令)を使用できるかどうか
ALIGN_STACK
OS Xコンパイラやその他の(Linux)コンパイラなどの厳密なスタックアライメント要求がない環境で定義(Delphi XE2以降)
PC_MAPPED_EXCEPTIONS
例外の巻き戻しにアドレスマップを使用するプラットフォーム用コンパイラで定義(Delphi XE2以降)
PIC
OS XのようにPIC(位置独立コード)が要求されるプラットフォームで定義(Delphi XE2以降)
AUTOREFCOUNT
ARC(Automatic Reference Counting)をサポートする環境で定義(Delphi XE4以降、Delphi 10.4 Sydneyですべてのコンパイラが未定義に)
EXTERNALLINKER
外部リンカを使用する環境で定義(Delphi XE4以降)
NEXTGEN
(LLVMベースの)"NEXTGEN"コンパイラで定義(Delphi XE4以降、Delphi 10.4 Sydneyですべてのコンパイラが未定義に)
ELF
実行/オブジェクトファイルがELF形式の環境で定義(Delphi 10.2以降)
UNDERSCOREIMPORTNAME
インポートされた名前が"_"(アンダースコア)付きになる環境で定義(Delphi XE4以降)
WEAKREF
弱い参照(weak reference)が有効な環境で定義(Delphi XE4以降)
WEAKINSTREF
弱い参照がインスタンスに定義される環境で定義(Delphi XE4以降、Delphi 10.4 Sydneyですべてのコンパイラが未定義に)
WEAKINTREF
弱い参照がインタフェースに定義される環境で定義(Delphi XE4以降)
FRAMEWORK_VCL
プロジェクトがVCLフレームワークを使用(Delphi 11.1以降)
FRAMEWORK_FMX
プロジェクトがFMXフレームワークを使用(Delphi 11.1以降)
WEAK_NATIVEINT
NativeInt/NativeUIntが型エイリアスの環境で定義(Delphi 12)
BCB
C++Builderで定義
WINDOWS
Win16環境で定義

ヘルプにはCPU32BITS/CPU64BITSはDelphi XE2以降との記述がありますが、実際にはDelphi XE8以降で有効です。

またVER<nnn>はそれぞれ以下のプロダクトで定義されています(VER180はDelphi/C++Builder 2006と2007の両方で定義済、VER185はDelphi/C++Builder 2007のみで定義済)。

VER40
Turbo Pascal 4.0
VER50
Turbo Pascal 5.0
VER55
Turbo Pascal 5.5
VER60
Turbo Pascal 6.0
VER10
Turbo Pascal for Windows 1.0
VER15
Turbo Pascal for Windows 1.5
VER70
Borland Pascal 7.0
VER80
Delphi 1
VER90
Delphi 2
VER93
C++Builder 1
VER100
Delphi 3
VER110
C++Builder 3
VER120
Delphi 4
VER125
C++Builder 4
VER130
Delphi 5, C++Builder 5
VER140
Delphi 6, C++Builder 6, Kylix 1, Kylix 2, Kylix 3
VER150
Delphi 7, 7.1
VER160
Delphi 8 for .NET, C#Builder
VER170
Delphi 2005, C++Builder 2005 (Ver9)
VER180
Delphi 2006, C++Builder 2006 (Ver10), Delphi 2007, C++Builder 2007 (Ver11)
VER185
Delphi 2007, C++Builder 2007 (Ver11)
VER190
Delphi 2007 for .NET (Ver11)
VER200
Delphi 2009, C++Builder 2009 (Ver12)
VER210
Delphi 2010, C++Builder 2010 (Ver14)
VER220
Delphi XE, C++Builder XE (Ver15)
VER230
Delphi XE2, C++Builder XE2 (Ver16)
VER240
Delphi XE3, C++Builder XE3 (Ver17)
VER250
Delphi XE4, C++Builder XE4 (Ver18)
VER260
Delphi XE5, C++Builder XE5, Appmethod 1.13 (Ver19)
VER265
Appmethod 1.13 (Ver19.5)
VER270
Delphi XE6, C++Builder XE6, Appmethod 1.14 (Ver20)
VER280
Delphi XE7, C++Builder XE7, Appmethod 1.15 (Ver21)
VER290
Delphi XE8, C++Builder XE8, Appmethod 1.16 (Ver22)
VER300
Delphi 10 Seattle, C++Builder 10 Seattle (Ver23)
VER310
Delphi 10.1 Berlin, C++Builder 10.1 Berlin (Ver24)
VER320
Delphi 10.2 Tokyo, C++Builder 10.2 Tokyo (Ver25)
VER330
Delphi 10.3 Rio, C++Builder 10.3 Rio (Ver26)
VER340
Delphi 10.4 Sydney, C++Builder 10.4 Sydney (Ver27)
VER350
Delphi 11 Alexandria, C++Builder 11 Alexandria (Ver28)
VER360
Delphi 12 Athens, C++Builder 12 Athens (Ver29)

RTLVersion<nnn(n)>はDelphi 10.4.2で導入されました。

RTLVersion1041
Delphi 10.4.2
RTLVersion1042
Delphi 10.4.2
RTLVersion111
Delphi 11.1
RTLVersion112
Delphi 11.2
RTLVersion113
Delphi 11.3
RTLVersion121
Delphi 12.1

ねた元はDelphi Tips - 0086とかDelphi Compiler Version Directives: {$IFDEF VER180}とか多数。もうちょっとヘルプが親切ならなぁ。オンラインヘルプの条件付きコンパイル（Delphi） (en)およびコンパイラ バージョン (en)に完全な定義が掲載されました。素晴らしい。

2008/12/23追記: Borland Compiler Conditional Defines - Delphiを参考にちょこちょこっと修正。

2009/09/02追記: Delphi/C++Builder 2010のVER210を追加。

2010/10/12追記: Delphi/C++Builder XEのVER220を追加。

2011/09/02追記: Delphi/C++Builder XE2関係を追加。

2012/09/02追記: Delphi/C++Builder XE3のVER240を追加。

2013/04/20追記: Delphi/C++Builder XE4のVER250/iOS/CPUARM/AUTOREFCOUNT/EXTERNAL_LINKER/NEXTGEN/UNDERSCOREIMPORTNAME/WEAKREF/WEAKINSTREF/WEAKINTREFを追加。

2013/09/12追記: Delphi/C++Builder XE5のVER260/Androidを追加。

2014/04/15追記: Appmethod 1のVER265とDelphi/C++Builder XE6のVER270を追加。

2014/09/02追記: Delphi/C++Builder XE7のVER280を追加。

2015/04/07追記: Delphi/C++Builder XE8のVER290を追加。

2015/09/01追記: Delphi/C++Builder 10 SeattleのVER300を追加。

2015/11/16追記: Delphi/C++Builder XE8以降のCPU32BITS/CPU64BITSを追加。

2016/04/20追記: Delphi/C++Builder 10.1 BerlinのVER310を追加。

2016/08/19追記: Compiler Versionsを参考に微妙に修正。

2017/03/23追記: Delphi/C++Builder 10.2 TokyoのVER320を追加。

2018/11/22追記: いくつかの標準条件シンボルが欠けていたのを修正。

2018/11/26追記: Delphi/C++Builder 10.3 RioのVER330を追加。

2020/06/01追記: Delphi/C++Builder 10.3.3 RioのANDROID64とDelphi/C++Builder 10.4 SydneyのVER340を追加。

2021/05/05追記: Delphi/C++Builder 10.4.2以降のRTLVersion<nnnn>(RTLVersion1041、RTLVersion1042)を追加。

2021/09/10追記: Delphi/C++Builder 11 AlexandriaのVER350とOSX/OSX64を追加。

2022/03/16追記: Delphi/C++Builder 11.1 AlexandriaのRTLVersion111とFRAMEWORK_VCL、FRAMEWORK_FMXを追加。

2022/09/13追記: Delphi/C++Builder 11.2 AlexandriaのRTLVersion112を追加。

2023/03/07追記: Delphi/C++Builder 11.3 AlexandriaのRTLVersion113を追加。

2023/11/09追記: Delphi/C++Builder 12 AthensのVER360を追加。

2023/11/24追記: Delphi/C++Builder 12 AthensのWEAK_NATIVEINTを追加。

2024/04/05追記: Delphi/C++Builder 12.1 AthensのRTLVersion121を追加。

Tiburonのビデオ 3週目

公式に新しいビデオがあがっています(公式発表したからか、"スニークピーク"ではなくなったようです)。
ビデオ: DataSnap – 多層／シンクライアントデータベースソリューションとデータリモーティング
ビデオ: C++Builder 2009 の新しいライブラリ機能– Boost と TR1

Delphi 2009/C++Builder 2009公式発表

日本語のプレスリリースがでています。
エンバカデロ・テクノロジーズ、Windows®向け開発ツールの次世代バージョン「Delphi® 2009」「C++Builder® 2009」を発表
出荷開始は2008/09/18とのこと。まぁこれなら大丈夫でしょう。

2008/09/16追記:
Team Japan » Delphi 2009 / C++Builder 2009 予定通り9月18日出荷開始
ということで出荷開始が確定したようです。まだ注文していないけど…。

[書籍]UnicodeによるJIS X 0213実装入門

Unicode/UCS/UTF関係をプログラム側から解説している本はあまり多くないけど、たまたま紀伊國屋新宿本店で見かけたので購入。

マイクロソフト公式解説書 UnicodeによるJIS X 0213実装入門/田丸健三郎著/日経BPソフトプレス/ISBN 978-4-89100-608-2/2,415円

Delphi 2009のUnicodeサポート

公式のUnicodeサポート関連の記事。
Delphi in a Unicode World Part I: What is Unicode, Why do you need it, and How do you work with it in Delphi?
Delphi in a Unicode World Part II: New RTL Features and Classes to Support Unicode

2008/09/11追記: Part III追加
Delphi in a Unicode World Part III: Unicodifying Your Code

2008/09/16追記:
日本語訳が公開されています。

Delphi/C++Builder 2009は08/25にリリース？

記事(CodeGear買収後：EmbarcaderoからDelphi、C++Builderの新リリースが登場 - ITmedia エンタープライズ/eWeek.comの元記事)にもなっててそれもNick Hodgesさんのblogからもリンクされて(しかも"Nice article"って)いるので半ば決まりなんだと思いますが、Delphi/C++Builder 2009が2008/08/25に発売されるようです。FTerとしては"本当？"って感じですけど。
でも藤井さんのblogでは今週末勝負！みたいですね。まぁ25日とはいってもPDTでしょうから、時差9+7=16時間で、日本では26日なのかな？

2008/08/26追記: とりあえず予約可能("Delphi 2009 and C++Builder 2009 are immediately available worldwide for pre-orders.")になったようです(press release)。

2008/08/26再追記: 公式発表されてます。

2011/05/04追記: codegear.comのリンクをembarcadero.comのものに差し替え。

ジェネリクスでイベントのマルチキャストを実現

興味深い。とりあえずメモ。
The Oracle at Delphi » Multicast events using generics

2008/08/26追記: 続編。
The Oracle at Delphi » Multicast Events - the cleanup

2008/09/04再追記: 最終回(?)。
The Oracle at Delphi » Multicast Events - the finale

Tiburonのスニークピークビデオ 2週目

公式に今週のスニークピークビデオがあがっています。
スニークピークビデオ - Delphi 2009 IDEの新機能
スニークピークビデオ - C++Builder 2009 IDEの新機能

キー入力関係のメッセージ処理

CDNに興味深いアーティクルが。
A Key’s Odyssey

Microsoft Monthly Update 2008/08

今日はMicrosoftのセキュリティアップデートの日です。
MS08-041
MS08-042
MS08-043
MS08-044
MS08-045
MS08-046
MS08-047
MS08-048
MS08-049
MS08-050
MS08-051

newsgroups.borland.com終了

newsgroups.borland.comがお亡くなりになったらしい。代替のディスカッションフォーラムではnntp(s)とhttp(s)の両方でインタフェースできる。でもnntpはquoted-printableだし、httpだと<pre>タグとか書きたいし、微妙ですね。

2008/08/23追記: ん？nntpがUTF-8でくるなぁ。まぁそのほうが望ましいからいいけど。

Tiburon Unicode Video #5

Marco Cantuさんとこの5本目。
Tiburon Unicode Video #5

Tiburon Unicode Video #4

Marco Cantuさんとこの4本目。
Tiburon Unicode Video #4

Tiburon Unicode Video #3

Marco Cantuさんとこの続き。
Tiburon Unicode Video #3
まだ全然見てない…今週末かな。

Tiburonのスニークピークビデオ & Tiburon Unicode Video #1,#2

公式にスニークピークのビデオがあがってますね。とりあえずメモ。
スニークピークビデオ - Delphi 2009 / C++Builder 2009のVCL新機能
スニークピークビデオ - C++Builderでの新しい C++0x 標準のサポート
今晩早く帰って見ることにしよう。ああ、でも新しいビル(以下NDAにより自粛

Marco Cantuさんとこにも。
Tiburon Unicode Video #1
Tiburon Unicode Video #2

プラットフォーム依存の解消

従来のDelphiの関数/ユニット/シンボルのうち、プラットフォームに依存するものは警告されないように以下のような置き換えが推奨されています。

• IncludeTrailingBackSlash() → IncludeTrailingPathDelimiter()


• ExcludeTrailingBackSlash() → ExcludeTrailingPathDelimiter()


• RaiseLastWin32Error() → RaiseLastOSError()


• FormsネームスペースのMakeObjectInstance()およびFreeObjectInstance() → ClassesネームスペースのMakeObjectInstance()およびFreeObjectInstance()


• uses FileCtrl → uses SysUtils


• MinimizeName() → 普通はラベル表示用なのでTLabel.EllipsisPositionプロパティをepPathEllipsisにするとか…

また以下のものは警告を抑止($WARN SYMBOL_PLATFORM OFF)するか無視するしかないと思われます。

• Win32Check


• SysUtilsネームスペースのfaReadOnly, faHidden, faSysFile, faArchive, faSymLink定数

警告の抑止

Kylix(懐かしい)以前のDelphiからコードを移行すると、プラットフォーム/ライブラリに依存している、あるいは使用を推奨されていない、と警告(W1000/W1001/W1002)されることがあります。
これらはplatform/library/deprecatedヒント指令を付加されたシンボルの使用によるもので、基本的には警告されないように書き換えることが望ましいわけですが、すべての局面で書き換え可能とは限りません。
そこでこれらの警告を抑止するときは以下のコンパイラディレクティブを使用します。

{$WARN SYMBOL_PLATFORM OFF}    // プラットフォーム依存コードの警告を抑止
{$WARN SYMBOL_LIBRARY OFF}     // ライブラリ依存コードの警告を抑止
{$WARN SYMBOL_DEPRECATED OFF}  // 下位互換性コードの警告を抑止

なるべく抑止区間が短くなるよう、必要なブロックの直後でON(Delphi 2009ではDEFAULT)しておきましょう。

ディレクトリツリーを削除する

指定されたディレクトリをその中身ごと削除するには、再帰しながらそのディレクトリに含まれる全てのファイルとサブディレクトリを削除していきます。

uses
  Windows, SysUtils, Classes;

procedure DeleteDirTree(const Path: String);
var
  Index: Integer;
  DirNames: TStringList;
  FileNames: TStringList;
  SearchRec: TSearchRec;
  Pathname: String;
begin

  if Path = '' then
  begin
    Exit;
  end;

  DirNames := nil;
  FileNames := nil;
  try
    DirNames := TStringList.Create;
    FileNames := TStringList.Create;

    { Search }
    if FindFirst(IncludeTrailingPathDelimiter(Path) + '*.*',faAnyFile,SearchRec) = 0 then
    begin
      try
        repeat
          if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
          begin
            Continue;
          end;

          Pathname := IncludeTrailingPathDelimiter(Path) + SearchRec.Name;

          if (SearchRec.Attr and faDirectory) <> 0 then
          begin
            DirNames.Add(Pathname);
          end
          else
          begin
            FileNames.Add(Pathname);
          end;

        until (FindNext(SearchRec) <> 0);

      finally
        FindClose(SearchRec);
      end;
    end;

    { Delete sub directories }
    for Index := 0 to DirNames.Count - 1 do
    begin
      DeleteDirTree(DirNames.Strings[Index]);  // recursive call
    end;

    { Delete files }
    for Index := 0 to FileNames.Count - 1 do
    begin
      if DeleteFile(FileNames.Strings[Index]) = False then
      begin
        RaiseLastOSError;
      end;
    end;

    { Delete current directory }
    if RemoveDir(Path) = False then
    begin
      RaiseLastOSError;
    end;

  finally
    DirNames.Free;
    FileNames.Free;
  end;

end;

よくあるミスはFincCloseせずにディレクトリを削除しようとしてアクセス拒否を食らう、というやつです(普通にトラバースするだけならFindCloseしなくてもエラーにならないので気付きにくい)。

Tiburon Book

Delphi関係の本を何冊も出しているMarco Cantuさんですが、現在Tiburonの本を執筆中とのこと。どこかの出版社で翻訳してくれないかなぁ。

エクスプローラからのファイルのドラッグアンドドロップを特定のコントロールで受け入れる

fエクスプローラからファイルをドラッグアンドドロップで受け入れるにはDragAcceptFilesで受け入れを許可し、WM_DROPFILESメッセージで通知を受け付け、DragQueryFileでドロップされた各ファイルを受け取ります。特定のコントロールでこれを行うには、ウィンドウプロシージャを置き換える必要があります。この例ではListBoxでドラッグアンドドロップを受け入れています。

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FPrevListBoxWindowProc: TWndMethod;
    procedure ListBoxWindowProc(var Message: TMessage);
    procedure ListBoxWMDropFiles(var Msg: TWMDropFiles);
  public
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  { Replace window procedure }
  FPrevListBoxWindowProc := ListBox1.WindowProc;
  ListBox1.WindowProc := ListBoxWindowProc;

  { Enable to accept drop files }
  DragAcceptFiles(ListBox1.Handle,True);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

  { Disable to accept drop files }
  DragAcceptFiles(ListBox1.Handle,False);

  { Restore window procedure }
  ListBox1.WindowProc := FPrevListBoxWindowProc;

end;

procedure TForm1.ListBoxWindowProc(var Message: TMessage);
begin

  if Message.Msg <> WM_DROPFILES then
  begin
    { Call previous window procedure }
    FPrevListBoxWindowProc(Message);
    Exit;
  end;

  { Call WM_DROPFILES handler }
  ListBoxWMDropFiles(TWMDropFiles(Message));
  Message.Result := 1;

end;

procedure TForm1.ListBoxWMDropFiles(var Msg: TWMDropFiles);
var
  Index: Integer;
  Count: Integer;
  Size: Integer;
  Filename: String;
begin

  try
    { Get dropped filename }
    Count := DragQueryFile(Msg.Drop,DWORD(-1),nil,0);

    for Index := 0 to Count - 1 do
    begin
      { Get filename length }
      Size := DragQueryFile(Msg.Drop,Index,nil,0) + 1;

      { Get filename }
      SetLength(Filename,Size);
      Size := DragQueryFile(Msg.Drop,Index,PChar(Filename),Size);
      SetLength(Filename,Size);

      ListBox1.Items.Add(Filename)
    end;

  finally
    { Finish }
    DragFinish(Msg.Drop);
  end;

end;

2010/08/04追記: こちらに詳細に説明していますが、Windows Vista/7ではUIPIにより下位ILのプロセスから上位ILのプロセスに対して通信、この場合はファイルのドラッグアンドドロップを行うことができなくなっています。

エクスプローラからのファイルのドラッグアンドドロップを受け入れる

エクスプローラからファイルをドラッグアンドドロップで受け入れるにはDragAcceptFilesで受け入れを許可し、WM_DROPFILESメッセージで通知を受け付け、DragQueryFileでドロップされた各ファイルを受け取ります。ドロップ先がフォームであれば普通にメッセージハンドラを記述すればよいのですが、特定の(TWinControlから派生した)コントロールで受け入れるためにはウィンドウプロシージャを置き換える必要があり、ちょっとハードルが高くなってしまいます。

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  public
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  { Enable to accept drop files }
  DragAcceptFiles(Handle,True);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

  { Disable to accept drop files }
  DragAcceptFiles(Handle,False);

end;

procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
  Index: Integer;
  Count: Integer;
  Size: Integer;
  Filename: String;
begin

  try
    { Get dropped filename }
    Count := DragQueryFile(Msg.Drop,DWORD(-1),nil,0);

    for Index := 0 to Count - 1 do
    begin
      { Get filename length }
      Size := DragQueryFile(Msg.Drop,Index,nil,0) + 1;

      { Get filename }
      SetLength(Filename,Size);
      Size := DragQueryFile(Msg.Drop,Index,PChar(Filename),Size);
      SetLength(Filename,Size);

      ListBox1.Items.Add(Filename)
    end;

  finally
    { Finish }
    DragFinish(Msg.Drop);
  end;

end;

2010/08/04追記: Windows Vista/7ではUIPI(User Interface Privilege Isolation、ユーザインタフェース特権分離)により、下位IL(Integrity Level)のプロセスから上位ILのプロセスに対して通信(メッセージを含む)を行うことができなくなっています。WindowsのExplorer(explorer.exe)は中IL(medium integrity level)で起動されていますから、高IL(high integrity level)で実行しているプログラムに対してファイルをドラッグアンドドロップすることはできない、ということになります。特にIDEを管理者権限で実行している場合、デバッグプロセスも管理者権限(=高IL)で実行されるため注意が必要です。詳しくはWindows Integrity Mechanism Designを参照してください。元ねたは公式フォーラムのエクスプローラからのドラッグ＆ドロップスレッドの高橋さんの回答と、そこにリンクされているMicrosoftのVisual Studioフォーラムの管理者として起動したVS2005でデバッグするとWM_DROPFILESが発生しないスレッド。

ファイル名を長い形式に変換(GetLongPathName版)

Win32APIのGetLongPathNameを使用して8.3形式の短いファイル名(Short File Name)の混じったフルパス名を全て長いファイル名(Long File Name)に変換する方法です。Windows 2000以降でのみ動作します。

uses
  Windows, SysUtils;

type
  TGetLongPathNameFunc = function(lpszShortPath: PChar;
                                  lpszLongPath: PChar;
                                  cchBuffer: DWORD): DWORD; stdcall;

function ToLongFilename(const Filename: String): String;
var
  Size: Integer;
  GetLongPathName: TGetLongPathNameFunc;
begin

  Result := Filename;

  if (Win32Platform = VER_PLATFORM_WIN32_NT) and
     (Win32MajorVersion >= 5) then  // Windows 2000 or later
  begin
    @GetLongPathName := GetProcAddress(GetModuleHandle('Kernel32.dll'),
{$IFDEF Unicode}
                                       'GetLongPathNameW');
{$ELSE}
                                       'GetLongPathNameA');
{$ENDIF}
    if Assigned(GetLongPathName) = True then
    begin
      { Calculate buffer size }
      Size := GetLongPathName(PChar(Filename),nil,0);
      if Size = 0 then
      begin
        Exit;
      end;

      { Convert to long name }
      SetLength(Result,Size);
      Size := GetLongPathName(PChar(Filename),PChar(Result),Size);
      SetLength(Result,Size);
    end;
  end;

end;

この例でもGetShortPathNameを使用する場合と同様に、対象となるファイルが存在しないと最初のGetLongPathName呼び出しで0が返ってきて変換不能になってしまうため、注意が必要です。

2018/11/08追記: TGetLongPathNameFuncの宣言で引数名が入れ替わっていたものを修正。ご指摘ありがとうございます。

ファイル名を短い形式に変換

長いファイル名(Long File Name)の混じったフルパス名を全て8.3形式の短いファイル名(Short File Name)に変換する(あまりあり得ない状況だとは思いますけど)にはGetShortPathNameを使用します。

uses
  Windows;

function ToShortFilename(const Filename: String): String;
var
  Size: Integer;
begin

  { Calculate buffer size }
  Size := GetShortPathName(PChar(Filename),nil,0);
  if Size = 0 then
  begin
    Result := Filename;
    Exit;
  end;

  { Convert to short name }
  SetLength(Result,Size);
  Size := GetShortPathName(PChar(Filename),PChar(Result),Size);
  SetLength(Result,Size);

end;

ただし対象となるファイルが存在しないと最初のGetShortPathName呼び出しで0が返ってきて変換不能になってしまうため、注意が必要です(この例では渡されたパス名をそのまま返すようにしています)。

FastMM4.84リリース

Delphi/C++Builder用のメモリマネージャFastMMが4.84に更新されています。Team Japan » C++Builder with FastMM 4.84からの情報。
何が変更されたのかの確認はこれから。

ファイル名を長い形式に変換

8.3形式の短いファイル名(Short File Name)の混じったフルパス名を全て長いファイル名(Long File Name)に変換するには、それぞれのディレクトリ/ファイル名を、FindFirstFileで得られるTWin32FindData(WIN32_FIND_DATA)構造体のcFileNameに格納されている長い名前で置き換えていきます。

uses
  Windows, SysUtils;

function ToLongFilename(const Filename: String): String;
var
  Path: String;
  BaseName: String;
  H: THandle;
  FD: TWin32FindData;
begin

  { Separate to path and base name }
  Path := ExtractFileDir(Filename);
  if Path = Filename then
  begin
    Result := Filename;
    Exit;
  end;
  BaseName := ExtractFileName(Filename);

  { Convert (recursive) }
  Path := ToLongFilename(Path);

  { Search using FindFirstFile/FindClose }
  Result := IncludeTrailingPathDelimiter(Path) + BaseName;
  H := Windows.FindFirstFile(PChar(Result),FD);
  if H = INVALID_HANDLE_VALUE then
  begin
    Exit;
  end;
  Windows.FindClose(H);

  Result := IncludeTrailingPathDelimiter(Path) + FD.cFileName;

end;

SFNに変換するGetShortPathNameのようにGetLongPathNameを使えばいいのかと思いきや、これではWindows NT 4.0が対象外になってしまいます。ターゲットをWindows 2000以降に限定するならいいのですけど。

仮想リストビュー

ListViewはWindowsのコモンコントロールですが、表示件数が100件を超えるあたりから処理がどんどん重くなっていき、10000件あたりになるとクリアするだけでも数秒掛かるようになってしまいます。そこで表示件数が多くなることが想定される場合は仮想リストビューを使用します。といってもListItemを追加、変更、削除する代わりにOwnerDataをTrueにした状態でCountを変更するかInvalidateで表示を無効化し、OnDataイベントで渡されたListItemのCaptionおよびSubItemsを設定するだけです。

procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin

  try
    Item.Caption := 'Line ' + IntToStr(Item.Index);
    Item.SubItems.Clear;
    Item.SubItems.Add('2nd column');
    Item.SubItems.Add('3rd column');

  except
    { Ignore exceptions }
  end;

end;

ただし仮想リストビューにした場合はListView_SetColumnWidthでLVSCW_AUTOSIZEやLVSCW_AUTOSIZE_USEHEADERを指定することはできません。

ListViewのカラムの幅を調整する

ListViewのカラムの幅をそのカラム内の文字列の最も長いものにあわせるにはListView_SetColumnWidthでカラム幅としてLVSCW_AUTOSIZEを指定します。

begin

  ListView_SetColumnWidth(ListView1.Handle,0,LVSCW_AUTOSIZE);

end;

第2パラメータはカラムのインデックスです。
またカラムヘッダの文字列も含めて幅を合わせるときはLVSCW_AUTOSIZE_USEHEADERを指定します。

begin

  ListView_SetColumnWidth(ListView1.Handle,0,LVSCW_AUTOSIZE_USEHEADER);

end;

なお仮想リストビューではうまくいきません。

StringBuilder

Delphi 2009で追加されるTStringBuilderは
Building strings with TStringBuilder
こんなものらしいです。CLRからDelphi.NET経由で今回導入となったようですが、う～ん？
C++のostreamに<<で出力していくようなイメージなんでしょうか。

第10回エンバカデロ・デベロッパーキャンプ

第10回エンバカデロ・デベロッパーキャンプは2008年09月09日(大阪は11日)開催だそうです。今回のスコッツバレーからの来日はNick Hodgesさん(Delphi Product Manager)。それにしてもアグレッシブな企画ですね。出演者(参加者じゃなくて)は集まるのかいな？

リストビューコントロールのReport形式で行毎に背景色を変える

リストビューコントロール(TListView)のReport形式で行毎に背景色を変えるにはOnCustomDrawItemイベントでSender.Canvas.Brush.Colorを変更します。

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
                                         Item: TListItem; 
                                         State: TCustomDrawState; 
                                         var DefaultDraw: Boolean);
begin

  if (Item.Index mod 2) = 0 then
  begin
    Sender.Canvas.Brush.Color := $FFE0FF;
  end
  else
  begin
    Sender.Canvas.Brush.Color := $FFFFE0;
  end;

end;

Canvasの属性だけを変更して実際の描画はDefaultDraw = TrueのままでTListViewに任せるのがポイントです。
同じように文字の色やスタイルなどの属性を変えるにはSender.Canvas.Font.ColorやSender.Canvas.Font.Styleを変更します。

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
                                         Item: TListItem;
                                         State: TCustomDrawState;
                                         var DefaultDraw: Boolean);
begin

  if cdsSelected in State then
  begin
    Sender.Canvas.Font.Style := Sender.Canvas.Font.Style + [fsBold];
  end;

end;

Delphi 2009のジェネリクスと匿名メソッド

Delphiの新機能のうちジェネリクス(Generics)と匿名メソッド(Anonymous methods)は
Sip from the Firehose : Tiburon - new language features for Delphi 2009
こんな感じになります。

Windowsをログオフ/リブート/シャットダウンする

Windowsをログオフ/リブート/シャットダウンするにはExitWindowsExを呼び出すのですが、NT系のOSではそれなりの特権をOpenProcessToken/LookupPrivilegeValue/AdjustTokenPrivilegesで取得しておく必要があります。

uses
  Windows, Forms, SysUtils;

{$WARN SYMBOL_PLATFORM OFF}
procedure ShutdownWindows(Flags: DWORD);
var
  TokenHandle: THandle;
  ReturnLength: DWord;
  NewTKP: TTokenPrivileges;
begin

  { Set shutdown privilege }
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    { Get current process token }
    Win32Check(OpenProcessToken(GetCurrentProcess,
                                TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
                                TokenHandle));

    { Get privilege }
    Win32Check(LookupPrivilegeValue(nil,'SeShutdownPrivilege',
                                  NewTKP.Privileges[0].Luid));

    { New privilege }
    NewTKP.PrivilegeCount := 1;
    NewTKP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

    { Get privilege for setting date and time }
    ReturnLength := 0;
    Win32Check(AdjustTokenPrivileges(TokenHandle,False,NewTKP,0,nil,ReturnLength));
    if GetLastError <> ERROR_SUCCESS then
    begin
      RaiseLastOSError;
    end;
  end;

  { ExitWindowsEx }
  Win32Check(ExitWindowsEx(Flags,0));

  { Terminate application }
  Application.Terminate;

end;
{$IFDEF VER200}  // Delphi 2009 or later
{$WARN SYMBOL_PLATFORM DEFAULT}
{$ELSE}
{$WARN SYMBOL_PLATFORM ON}  
{$ENDIF}

const
  CForceIfHung: array [Boolean] of DWORD = (0,EWX_FORCEIFHUNG);

procedure LogOff(ForceIfHung: Boolean);
begin

  ShutdownWindows(EWX_LOGOFF or CForceIfHung[ForceIfHung]);

end;

procedure PowerOff(ForceIfHung: Boolean);
begin

  ShutdownWindows(EWX_POWEROFF or CForceIfHung[ForceIfHung]);

end;

procedure Reboot(ForceIfHung: Boolean);
begin

  ShutdownWindows(EWX_REBOOT or CForceIfHung[ForceIfHung]);

end;

procedure Shutdown(ForceIfHung: Boolean);
begin

  ShutdownWindows(EWX_SHUTDOWN or CForceIfHung[ForceIfHung]);

end;

Blogger Syntax Highlighter

コード部分をBlogger Syntax Highlighterで見やすくしてみました。

全角→半角変換

文字列中の全角文字を(可能な範囲で)半角に変換するのにもLCMapStringを使用します。ちなみにLCMapStringのA版はバイト数で、W版は文字数で長さを扱うので注意が必要です。

uses
  Windows;

function ZenkakuToHankaku(const Str: String): String;
{$IFNDEF UNICODE}
const
  TestStr: String = '亜';
{$ENDIF}
var
  Size: Integer;
  Flags: DWORD;
{$IFNDEF UNICODE}
  Multiplier: Integer;
{$ENDIF}
begin

  Flags := LCMAP_HALFWIDTH;
{$IFNDEF UNICODE}
  Multiplier := 1;
{$ENDIF}

  { Calculate destination size }
{$IFNDEF UNICODE}
  if LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                 PChar(TestStr),Length(TestStr),nil,0) = 1 then
  begin
    Multiplier := 2;
  end;
{$ENDIF}
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                      PChar(Str),Length(Str),nil,0);
{$IFNDEF UNICODE}
  Size := Size * Multiplier;
{$ENDIF}

  { Convert }
  SetLength(Result,Size);
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                      PChar(Str),Length(Str),PChar(Result),Size);
  if Size <= 0 then
  begin
    Result := Str;
    Exit;
  end;
  SetLength(Result,Size);

end;

2011/05/19追記: Windows 7の互換モードにおけるLCMapStringの不具合を回避するため、ANSI版の動作を修正しました。オリジナルのコードはこちら。

uses
  Windows;

function ZenkakuToHankaku(const Str: String): String;
var
  Size: Integer;
  Flags: DWORD;
begin

  Flags := LCMAP_HALFWIDTH;

  { Calculate destination size }
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,PChar(Str),Length(Str),nil,0);

  { Convert }
  SetLength(Result,Size);
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                      PChar(Str),Length(Str),PChar(Result),Size);
  if Size <= 0 then
  begin
    Result := Str;
    Exit;
  end;
  SetLength(Result,Size);

end;

半角→全角変換

LCMapStringを使用して文字列中の英数字を全角英数字に、いわゆる半角カタカナおよびひらがなを全角カタカナに、それぞれ変換します。第2パラメータを変更することで変換の動作を変更することもできます。

uses
  Windows;

function KanaToZenkaku(const Str: String): String;
{$IFNDEF UNICODE}
const
  TestStr: String = 'A';
{$ENDIF}
var
  Size: Integer;
  Flags: DWORD;
{$IFNDEF UNICODE}
  Multiplier: Integer;
{$ENDIF}
begin

  Flags := LCMAP_FULLWIDTH or LCMAP_KATAKANA;
{$IFNDEF UNICODE}
  Multiplier := 1;
{$ENDIF}

  { Calculate destination size }
{$IFNDEF UNICODE}
  if LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                 PChar(TestStr),Length(TestStr),nil,0) = 1 then
  begin
    Multiplier := 2;
  end;
{$ENDIF}
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                      PChar(Str),Length(Str),nil,0);
{$IFNDEF UNICODE}
  Size := Size * Multiplier;
{$ENDIF}

  { Convert }
  SetLength(Result,Size);
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                      PChar(Str),Length(Str),PChar(Result),Size);
  if Size <= 0 then
  begin
    Result := Str;
    Exit;
  end;
  SetLength(Result,Size);

end;

2011/05/19追記: Windows 7の互換モードにおけるLCMapStringの不具合を回避するため、ANSI版の動作を修正しました。オリジナルのコードはこちら。

uses
  Windows;

function KanaToZenkaku(const Str: String): String;
var
  Size: Integer;
  Flags: DWORD;
begin

  Flags := LCMAP_FULLWIDTH or LCMAP_KATAKANA;

  { Calculate destination size }
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,PChar(Str),Length(Str),nil,0);

  { Convert }
  SetLength(Result,Size);
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,Flags,
                      PChar(Str),Length(Str),PChar(Result),Size);
  if Size <= 0 then
  begin
    Result := Str;
    Exit;
  end;
  SetLength(Result,Size);

end;

リモートPCの共有パスに接続する

Microsoftファイル共有でリモートPCの共有パスに接続するときはWNetAddConnection2を、接続を解除するときはWNetCancelConnection2を使用します。

uses
  Windows;

procedure DoLogOn(var RemotePath: String; const UserName: String;
                  const Password: String);
var
  NR: TNetResource;
  Win32Result: Integer;
begin

  { Check local path }
  if (RemotePath = '') or (Copy(RemotePath,1,2) <> '\\') then
  begin
    Exit;
  end;

  RemotePath := ExcludeTrailingPathDelimiter(RemotePath);

  with NR do
  begin
    dwType := RESOURCETYPE_ANY;
    lpLocalName := nil;
    lpRemoteName := PChar(RemotePath);
    lpProvider := nil;
  end;

  Win32Result := WNetAddConnection2(NR,PChar(Password),
                                    PChar(UserName),0);
  if Win32Result <> NO_ERROR then
  begin
    RaiseLastOSError(Win32Result);
  end;

end;

procedure DoLogOff(const RemotePath: String);
var
  Pathname: String;
  Win32Result: Integer;
begin

  { Check local path }
  if (RemotePath = '') or (Copy(RemotePath,1,2) <> '\\') then
  begin
    Exit;
  end;

  Win32Result := WNetCancelConnection2(PChar(Pathname),0,False);
  if Win32Result <> NO_ERROR then
  begin
    RaiseLastOSError(Win32Result);
  end;

end;

年齢の計算

任意の日付における生物学的(?)年齢を計算する方法。日本の法律では誕生日の前日の満了を以って年齢が加算される(明治三十五年法律第五十号(年齢計算ニ関スル法律)、民法(明治二十九年四月二十七日法律第八十九号)第百四十三条および年齢のとなえ方に関する法律(昭和二十四年五月二十四日法律第九十六号))ため、法的年齢を要求される場合は注意が必要です。

uses
  Windows, SysUtils;

function GetAge(ABirthday: TDateTime; ABase: TDateTime;
                var AYear: Integer; var AMonth: Integer;
                var ADate: Integer; var AWeek: Integer): Integer;
var
  DT: TDateTime;
  ST1: TSystemTime;
  ST2: TSystemTime;
  ST3: TSystemTime;
begin

  { Decode }
  DecodeDate(ABirthday,ST1.wYear,ST1.wMonth,ST1.wDay);
  DecodeDate(ABase,ST2.wYear,ST2.wMonth,ST2.wDay);

  AYear  := ST2.wYear  - ST1.wYear;
  AMonth := ST2.wMonth - ST1.wMonth;
  ADate  := ST2.wDay   - ST1.wDay;

  if (ST1.wMonth > ST2.wMonth) or
     ((ST1.wMonth = ST2.wMonth) and (ST1.wDay > ST2.wDay)) then
  begin
    AYear  := AYear  -  1;
    AMonth := AMonth + 12;
  end;

  { Regulate date }
  if ADate < 0 then
  begin
    AMonth := AMonth - 1;

    ST3.wYear  := ST1.wYear  + AYear;
    ST3.wMonth := ST1.wMonth + AMonth;
    ST3.wDay   := ST1.wDay;
    if ST3.wMonth > 12 then
    begin
      ST3.wYear  := ST3.wYear  +  1;
      ST3.wMonth := ST3.wMonth - 12;
    end;

    DT := ABase;
{$IFDEF CONDITIONALEXPRESSIONS}
    { Delphi 6 or later }
    while TryEncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay,DT) = False do
    begin
      ST3.wDay := ST3.wDay - 1;
    end;
{$ELSE}
    { Delphi 5 or before }
    repeat
      try
        DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

      except
        ST3.wDay := ST3.wDay - 1;
        Continue;
      end;

      Break;
    until False;
{$ENDIF}

    ADate := Trunc(ABase - DT);
  end;

  { Calc weeks }
  DT := ABase;
  ST3.wYear  := ST1.wYear + AYear;
  ST3.wMonth := ST1.wMonth;
  ST3.wDay   := ST1.wDay;
{$IFDEF CONDITIONALEXPRESSIONS}
  { Delphi 6 or later }
  while TryEncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay,DT) = False do
  begin
    ST3.wDay := ST3.wDay - 1;
  end;
{$ELSE}
  { Delphi 5 or before }
  repeat
    try
      DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

    except
      ST3.wDay := ST3.wDay - 1;
      Continue;
    end;

    Break;
  until False;
{$ENDIF}

  AWeek := Trunc(ABase - DT) div 7;

  Result := AYear;

end;

ABirthdayに誕生日、ABaseに基準日を渡すとAYear/AMonth/ADateに経過年/月/日数が、AYear/AWeekに経過年/週数が格納されます。

2010/12/16追記: 経過日数、経過週数の補正処理の部分で、Delphi 6以降({$IFDEF CONDITIONALEXPRESSIONS}で判別)ではEncodeDateの呼び出しとそこからの例外の送出ではなくTryEncodeDateとその戻値を使用するように変更しました。オリジナルのコードは以下に置いておきます。

uses
  Windows, SysUtils;

function GetAge(ABirthday: TDateTime; ABase: TDateTime;
                var AYear: Integer; var AMonth: Integer;
                var ADate: Integer; var AWeek: Integer): Integer;
var
  DT: TDateTime;
  ST1: TSystemTime;
  ST2: TSystemTime;
  ST3: TSystemTime;
begin

  { Decode }
  DecodeDate(ABirthday,ST1.wYear,ST1.wMonth,ST1.wDay);
  DecodeDate(ABase,ST2.wYear,ST2.wMonth,ST2.wDay);

  AYear  := ST2.wYear  - ST1.wYear;
  AMonth := ST2.wMonth - ST1.wMonth;
  ADate  := ST2.wDay   - ST1.wDay;

  if (ST1.wMonth > ST2.wMonth) or
     ((ST1.wMonth = ST2.wMonth) and (ST1.wDay > ST2.wDay)) then
  begin
    AYear  := AYear  -  1;
    AMonth := AMonth + 12;
  end;

  { Regulate date }
  if ADate < 0 then
  begin
    AMonth := AMonth - 1;

    ST3.wYear  := ST1.wYear  + AYear;
    ST3.wMonth := ST1.wMonth + AMonth;
    ST3.wDay   := ST1.wDay;
    if ST3.wMonth > 12 then
    begin
      ST3.wYear  := ST3.wYear  +  1;
      ST3.wMonth := ST3.wMonth - 12;
    end;

    DT := ABase;
    repeat
      try
        DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

      except
        ST3.wDay := ST3.wDay - 1;
        Continue;
      end;

      Break;
    until False;

    ADate := Trunc(ABase - DT);
  end;

  { Calc weeks }
  DT := ABase;
  ST3.wYear  := ST1.wYear + AYear;
  ST3.wMonth := ST1.wMonth;
  ST3.wDay   := ST1.wDay;
  repeat
    try
      DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

    except
      ST3.wDay := ST3.wDay - 1;
      Continue;
    end;

    Break;
  until False;
  AWeek := Trunc(ABase - DT) div 7;

  Result := AYear;

end;

ファイルをWindowsの関連付けに従って開く

プログラムの動作状況をログファイルに記録する、というのはよくある話ですが、これをWindowsの関連付けに従って開く(たとえば.LOGファイルをメモ帳やテキストエディタで開く)にはShellExecuteを使用します。

uses
  Windows, Forms, ShellAPI;

procedure OpenFileWithAssociation(const Filename: String);
begin

  ShellExecute(Application.Handle,nil,PChar(Filename),nil,nil,SW_SHOWDEFAULT);

end;

ログファイルのたぐいも従来は実行ファイルと同じ場所に書き込みね、なんてやっていましたが、Windows XP/VistaではCSIDL_LOCAL_APPDATAの下に配置するのが望ましいってことになり、これをテキストエディタで開こうにもものすごく深いパスにあるわけで、こういう機能をプログラム側で用意しておくと自分が楽ですよね。

UACエレベーションを要求してプログラムを実行

コントロールパネルの"日付と時刻"のようにWindows VistaのUACの対象となるプログラムを起動するにはShellExecuteでverbにrunasを指定します。ただしWindows 2000/XPではrunasを指定できないので代わりにデフォルトを示すNULLを指定します。

uses
  Windows, SysUtils, ShellAPI;

function ExecChildProcessAsAdmin(const CommandLine: String;
                                 const Parameters: String): Boolean;
const
  CRunAs: String = 'runas';
var
  POperation: PChar;
begin

  if Win32MajorVersion >= 6 then
  begin
    POperation := PChar(CRunAs);
  end
  else
  begin
    POperation := nil;
  end;

Result := (ShellExecute(0,POperation,PChar(CommandLine),PChar(Parameters),
                        nil,SW_SHOWNORMAL) > 32);

end;

これでWindows Vistaでは画面がブラックアウトして確認のダイアログが表示されます。
ちなみにUACエレベーションを要求するrunasというverbは未だにundocumentedみたいです。

2008/11/17追記: ユーザが権限の昇格を拒否した場合、ShellExecuteはFALSE(0)を返し、GetLastErrorの値はERROR_CANCELLED(1223)となります。元ねたはAdvanced Windows 第5版 上 p.144

Delphi/C++Builder 2009

いよいよDelphi/C++Builder 2009(Tiburon)の発売(2008年9月？)に向かって情報開示が始まりました。新機能として公開されているのは現時点では

• Unicodeフルサポート
• ジェネリクス(パラメタライズドタイプ)
• 匿名メソッド
• 新しいコンポーネント

といったところでしょうか。今回もDelphi/C++Builderは先行するようで、RAD Studioは2008年4Qそれ以降になる見込みです。

2008/07/28追記: RAD Studioの時期(2008年4Q)の根拠はどっかの(CodeGear関係者の)blogだったと思うのですが、ちょっと見つからないので一時的に表現を修正させていただきます。

2011/05/04追記: dn.codegear.comのリンクをedn.embarcadero.comのものに差し替え。

ショートカットをプログラムから作成する

プログラムから実行ファイルへのショートカットを作成するにはCOMオブジェクトのシェルリンク機能をIShellLinkとIPersistFileを使用して呼び出します。

uses
  SysUtils, ShlObj, ActiveX, ComObj;

function CreateShortCut(const Location: String;
                        const ShortcutName: String;
                        const FullPathname: String;
                        const Params: String;
                        const WorkingDir: String;
                        const Description: String): Boolean;
var
  Unknown: IUnknown;
  ShellLink: IShellLink;
  PersistFile: IPersistFile;
{$IFDEF Unicode}
  FileName: String;
{$ELSE}
  FileName: WideString;
{$ENDIF}
begin

  { Create shell link object }
  Unknown := CreateComObject(CLSID_ShellLink);

  { Get IShellLink/IPersistent inferface }
  ShellLink   := Unknown as IShellLink;
  PersistFile := Unknown as IPersistFile;

  { Set path to shell link }
  ShellLink.SetPath(PChar(FullPathname));

  { Set arguments to shell link }
  ShellLink.SetArguments(PChar(Params));

  { Set description string }
  ShellLink.SetDescription(PChar(Description));

  { Set working directory }
  ShellLink.SetWorkingDirectory(PChar(WorkingDir));

  { Set location (path and index) of the icon }
  ShellLink.SetIconLocation(PChar(FullPathname),0);

  { Save to file }
  FileName := IncludeTrailingPathDelimiter(Location) +
              ShortcutName + '.LNK';
{$IFDEF Unicode}
  Result := Succeeded(PersistFile.Save(PChar(FileName),True));
{$ELSE}
  Result := Succeeded(PersistFile.Save(PWChar(FileName),True));
{$ENDIF}

end;

元ねたは現Embarcadero Technologies社員でローカライズ担当の新井さんのDelphiの神託 DelphiによるCOMの徹底活用 シェルプログラミング入門(新井 正広著/ソフトバンク/ISBN4-7973-0782-X)。出版当時新井さんはまだ学生さんだった気がします。

2008/07/30追記: Windowsが管理している場所(スタートメニューなど)にショートカットを作成したときは

  SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0);

を行わないと次回起動時まで表示に反映されない、という点に注意してください。

接続されていないデバイスの情報を表示させる

接続されていないデバイスのドライバを削除したい場合など、現在接続されていないものも含めて全てのデバイスをデバイスマネージャに表示させるには、コマンドプロンプト(UAC有効の場合は管理者として実行)から

set devmgr_show_nonpresent_devices=1
cd %SystemRoot%\System32
start devmgmt.msc

として、表示されたデバイスマネージャの表示メニューから"非表示のデバイスの表示"を選択します。
Windows XPやWindows Vistaではデバイスは追加できても削除できないようなので、そのような場合にはこの方法が有効です。以下に参考リンクを。

KB241257 Windows 2000 に現在存在しないデバイスがデバイス マネージャに表示されない
KB315539 Windows XP ベースのコンピュータに接続されていないデバイスがデバイス マネージャに表示されない
接続されていないデバイスの情報を表示させる － ＠IT

IP(v4)アドレスの正規形表現への変換

入力されたIP(v4)アドレスを正規形の表現に変換する方法はいくらでもありそうですが、手抜きでWinSockのinet_addrとinet_ntoaを使用して文字列→IPアドレス→文字列とするやり方を。

function CanonicalizeIPAddress(const AIPAddress: String): String;
var
  P: PAnsiChar;
  IPAddr: in_addr;
{$IFDEF UNICODE}
  AnsiIPAddress: AnsiString;
{$ENDIF}
begin

{$IFDEF UNICODE}
{$WARN EXPLICIT_STRING_CAST_LOSS OFF}  // W1060
  AnsiIPAddress := AnsiString(AIPAddress);
{$WARN EXPLICIT_STRING_CAST_LOSS DEFAULT}
  IPAddr.S_addr := inet_addr(PAnsiChar(AnsiIPAddress));
{$ELSE}
  IPAddr.S_addr := inet_addr(PAnsiChar(AIPAddress));
{$ENDIF}

  if IPAddr.S_addr = u_long(INADDR_NONE) then
  begin
    raise EConvertError.CreateFmt('Bad IP address: %s',[AIPAddress]);
  end;

  P := inet_ntoa(IPAddr);
{$IFDEF UNICODE}
  SetString(AnsiIPAddress,P,StrLen(P));
  Result := String(AnsiIPAddress);
{$ELSE}
  SetString(Result,P,StrLen(P));
{$ENDIF}

end;

入力がIPアドレスとして不適切(INADDR_NONE)だと例外が発生しますが、かといって全部が全部エラーになるわけではない(暗黙に0が埋められる場合とか)ところは要注意かな。

2008/08/25追記: コードサンプルをUnicode Readyなものに更新しました。

特殊フォルダのパス名の取得

Windowsの特殊フォルダのCSIDLからパス名を取得するにはSHGetFolderPathを使用します。

uses
  Windows, SHFolder;

function GetSpecialFolder(csidl: Integer): String;
var
  Buffer: array [0..MAX_PATH] of Char;
begin

  Result := '';
  if Succeeded(SHGetFolderPath(0,csidl,0,0,Buffer)) = True then
  begin
    Result := Buffer;
  end;

end;

ただし全てのCSIDL_...が有効なパスを返すとは限らない(SHGetFolderPathでパスが取得できないCSIDLもあり、また環境にも依存する)ので注意が必要。

2008/07/17追記: SHGetFolderPathの第4パラメータは正確には
SHGFP_TYPE_CURRENT(0): 実際のパス
SHGFP_TYPE_DEFAULT(1): デフォルトのパス
のどちらかを指定します。SHGFP_TYPE_CURRENTを指定するとユーザによって特殊フォルダのパス名が変更されていた場合でもこれを反映したものを返します。SHGFP_TYPE_DEFAULTを指定するとシステム本来の(デフォルトの)パスを返します。

Adobe Readerで指定したファイルの指定したページを開く

2017/03/07追記: Adobe Acrobat/Reader X以降でDDEのサービス名が変更になったことに対応したアーティクルを作成しましたので、そちらをご覧ください。
Adobe Reader(X以降)で指定したファイルの指定したページを開く

PDFファイルの任意のページをプログラムから開くときは、Adobe Readerのパスをレジストリから取得し、DDEでキックしてからDocOpenでPDFを開きDocGotoで所定のページに移動する、というマクロを実行します。

uses
{$IFDEF Unicode}
  AnsiStrings,
{$ENDIF}
  Windows, SysUtils, DdeMan, Registry;

function GetAdobeReader: String;
begin

  with TRegistry.Create do
  begin
    try
      RootKey := HKEY_CLASSES_ROOT;
      OpenKeyReadOnly('Software\Adobe\Acrobat\Exe');
      try
        Result := ReadString('');

      finally
        CloseKey;
      end;

    finally
      Free;
    end;
  end;

end;


procedure OpenPDF(const Filename: String; Page: Integer);
const
  CDdeCommand: AnsiString = '[DocOpen("%s")][DocGoTo(NULL,%d)]';
var
  Macro: AnsiString;
begin

  Macro := Format(CDdeCommand,[Filename,Page - 1]);

  with TDdeClientConv.Create(nil) do
  begin
    try
      ConnectMode := ddeManual;
      ServiceApplication := ChangeFileExt(GetAdobeReader,'');
      SetLink('Acroview','Control');
      if OpenLink = True then
      begin
        ExecuteMacro(PAnsiChar(Macro),False);
        CloseLink;
      end;

    finally
      Free;
    end;
  end;

end;

Adobe Readerの所在は"HKEY_CLASSES_ROOT\Software\Adobe\Acrobat\Exe"から取得する(これが一番確実)、Adobe ReaderはDDEで呼び出してマクロ実行でファイルを開きページを移動する、DelphiのTDdeClientConvには不具合があるので使用する都度生成しないと正常に動作しない、といったところが注意点ですかね。

2008/08/16追記: AnsiString版のFormatを使用するようにコードを修正しました。

2009/03/17再追記: Adobe Acrobat/ReaderのDDEコマンドなどを定義した"Interapplication Communication API Reference"(アプリケーション間通信APIリファレンス)がAdobeのサイトにあります(英語ですが)。
Adobe Acrobat 7.0.5 Acrobat Interapplication Communication Reference
Adobe Acrobat SDK Version 8.0 Interapplication Communication API Reference

2017/03/05追記: おかぽんさんからAcrobat X以降では仕様の変更があったという情報をコメントでいただきました。調査してわかったことがありましたら追記します。(Bloggerはコメントが見づらいのでここに追記しておきます。おかぽんさん、情報ありがとうございました。)

ファイルサイズの取得

フルパス名からファイルのサイズを取得する方法は色々考えられますが、直球なのはFindFirstFileでFindDataのnFileSizeLowとnFileSizeHighから計算する方法でしょうか。

uses
  Windows;

function GetFileSize(const Filename: String; var FileSize: Int64): Boolean;
var
  Handle: THandle;
  FindData: TWin32FindData;
begin

  FileSize := 0;
  Handle := Windows.FindFirstFile(PChar(Filename),FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    FileSize := FindData.nFileSizeLow or Int64(FindData.nFileSizeHigh) shl 32;
    Result := True;
    Exit;
  end;
  Result := False;

end;

戻値がTrueならばFileSizeに取得したファイルサイズが格納されています。

2008/12/16追記: KB961110の問題を回避するためにWin32APIのGetFileSizeExを使用する方法をファイルサイズを取得する(2)に示しました。

プリンタの用紙のサイズおよび方向を変更

プリンタの用紙のサイズおよび方向を変更するときはGetPrinter/SetPrinterを使用します。

uses
  Printers;

var
  Device: array [0..127] of Char;
  Driver: array [0..127] of Char;
  Port: array [0..127] of Char;
  DeviceMode: THandle;
  pDevMode: ^TDevMode;
begin

  { Lock }
  Printer.GetPrinter(Device,Driver,Port,DeviceMode);
  pDevMode := GlobalLock(DeviceMode);
  try
    { Set paper orientation }
    pDevMode^.dmOrientation := DMORIENT_PORTRAIT;  // 用紙は縦

    { Set paper size }
    pDevMode^.dmPaperSize := DMPAPER_A4;  // 用紙はA4

  finally
    { Unlock }
    GlobalUnlock(DeviceMode);
  end;

  Printer.SetPrinter(Device,Driver,Port,DeviceMode);

end;

元ねたはDelphi Graphic Secrets Know-how & Libraries(中村 拓男著/ソフトバンクパブリッシング/ISBN4-7973-1922-4)。

シリアルポートの列挙

PC上で使用できるシリアルポートはレジストリの"HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM"上の"COM"で始まるエントリを列挙すればよい。ただしこのエントリはOpenKeyReadOnlyで開かないとユーザ権限によってはエラーになるので要注意。

uses
  Windows, SysUtils, Classes, Registry;

function EnumSerialComm(const S: TStrings): Integer;
var
  Index: Integer;
  PortNo: Integer;
  Str: String;
  Names: TStringList;
begin

  Result := 0;

  S.Clear;

  { Create temporary string list object }
  Names := TStringList.Create;
  try
    { Create and open registry key }
    with TRegistry.Create do
    begin
      try
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKeyReadOnly('\HARDWARE\DEVICEMAP\SERIALCOMM');
        try
          { Get names }
          GetValueNames(Names);

          { Read key values }
          for Index := 0 to Names.Count - 1 do
          begin
            if GetDataType(Names.Strings[Index]) = rdString then
            begin
              Str := ReadString(Names.Strings[Index]);
              if CompareText(Copy(Str,1,3),'COM') = 0 then
              begin
                PortNo := StrToIntDef(Copy(Str,4,Length(Str)),-1);
                if PortNo > 0 then
                begin
                  S.AddObject(Str,Pointer(PortNo));
                  if Result < PortNo then
                  begin
                    Result := PortNo;
                  end;
                end;
              end;
            end;
          end;

        finally
          { Close registry key }
          CloseKey;
        end;

      finally
        Free;
      end;
    end;

  finally
    { Release local objects }
    Names.Free;
  end;

end;

取り込んだシリアルポートはソートされていない(レジストリのエントリ順)なので、必要に応じてソートしてから使用しましょう。

TColor型と色名(文字列)の相互変換

TColor型と色名の文字列の相互変換にはGraphicsネームスペースのStringToColor/ColorToStringを使用します。

uses
  Graphics;

var
  Color: TColor;
begin

  Color := StringToColor('clRed');  // Color <- clRed

end;

var
  ColorName: String;
begin

  ColorName := ColorToString(clBlue);  // ColorName <- 'clBlue'

end;

TColorは列挙型ではないのでGetEnumName/GetEnumValueではうまくいかない。

列挙型と列挙子名(文字列)の相互変換

列挙型と列挙子名の文字列の相互変換にはTypInfoネームスペースのGetEnumName/GetEnumValueを使用します。

uses
  TypInfo, SysConst;

var
  Alignment: TAlignment;
  Value: Integer;
  P: PTypeInfo;
begin

  P := TypeInfo(TAlignment);
  Value := GetEnumValue(P,'taLeftJustify');
  with GetTypeData(P)^ do
  begin
    if (Value < MinValue) or (Value > MaxValue) then
    begin
      raise ERangeError.CreateRes(@SRangeError);
    end;

    Alignment := TAlignment(Value);  // Alignment <- taLeftJustify
  end;

end;

var
  AlignmentName: String;
begin

  AlignmentName := GetEnumName(TypeInfo(TAlignment),
                               Ord(taRightJustify));  // AlignmentName <- 'taRightJustify'

end;

2008/08/16追記: 該当する列挙子名が存在しないとGetEnumValueが-1を返す問題の対策を追加しました。

2012/05/08追記: 列挙型と列挙子名(文字列)の相互変換(ジェネリックス版)もどうぞ(Delphi 2009以降)。

Windows Vista上で管理者権限を要求するアプリケーションを作成する

Delphi 2007でWindows Vista/Server 2008上で管理者権限を要求するアプリケーションを作成するには:

1.まず普通にアプリケーションを作成する。このときプロジェクトオプションでランタイムテーマを一旦有効にしておく。
2.実行プログラムをリソースエディタ(今回はXN Resource Editorを使用)で開き、左側のツリーペインで"XP Theme Manifest"→"1"→"日本語"でマニフェスト部分を表示させて全て選択してCtrl-Cでコピーし、UTF-8を扱えるエディタに貼り付ける。
3.level="asInvoker"の"asInvoker"を"requireAdministrator"に書き換えてファイルを拡張子.manifest、文字コードUTF-8で保存する。
4.マニフェストをリンクするための.rcファイルを作成する。内容は

1 24 "<manifestfilename>.manifest"

の1行だけ(<manifestfilename>には3.でマニフェストを保存したときのファイル名を入れる)。
5.プロジェクトオプションでランタイムテーマを無効に設定する。
6.プロジェクトマネージャで実行ファイルを右クリック→"追加"で4.の.rcファイルを指定する。これでDelphi2007ではプロジェクトソースの最初のところに

{$R 'XYZ.res' 'XYZ.rc'}

という1行が挿入される。
8.プログラムをコンパイルしなおす。これで改変したマニフェストがリンクされた実行ファイルができているはず。リソースエディタで"XP Theme Manifest"の内容がlevel="requireAdministrator"となっていることを確認。

このプログラムをWindows Vista上で実行すると例のUACのダイアログが表示され、実行を許可するとプログラムが管理者権限で動作するはずです。

元ねたは第4回デベロッパーキャンプの【G4】テクノロジープレビュー「Delphi 2007 for Win32によるWindows Vista対応」から。

Windows XP以降のウィンドウゴースト機能を回避

Windows XP以降ではUIを持ったアプリケーションが5秒以上メッセージループを回さないとウィンドウゴースト機能(window ghosting feature)が働いて、そのアプリケーションのトップレベルウィンドウと同じ位置、サイズ、キャプションを持ったゴーストウィンドウが生成されます。
まぁそれはそれでいいのですが、アプリケーションがこの状態から復帰したときに、(1)Zオーダが狂ってしまい、直後の最前面ウィンドウ表示が最背面に回されてしまう、(2)Windows Vistaのタスクバーにゴーストウィンドウが残ってしまう、という微妙な(状況によっては厄介な)問題があります。
そこでウィンドウゴースト機能を停止してしまえ、ということでDisableProcessWindowsGhostingのサンプルコードです。

uses
  Windows, SysUtils;

procedure DisableProcessWindowsGhosting;
var
  PDisableProcessWindowsGhosting: procedure; stdcall;
begin

  if (Win32Platform = VER_PLATFORM_WIN32_NT) and
     (((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) or  // Windows XP
      (Win32MajorVersion >= 6)) then                             // Windows Vista or later
  begin
    @PDisableProcessWindowsGhosting := GetProcAddress(GetModuleHandle('user32.dll'),
                                                      'DisableProcessWindowsGhosting');
    if Assigned(PDisableProcessWindowsGhosting) = True then
    begin
      PDisableProcessWindowsGhosting;
    end;
  end;

end;

元ねたはCodeGearのQC3730から。

2011/05/04追記: QC3730のリンクをqc.embarcadero.comのものに差し替え。

Microsoft Monthly Update 2008/07

今日はMicrosoftのセキュリティアップデートの日です。
MS08-037
MS08-038
MS08-039
MS08-040

はじめに

Embarcadero TechnologiesのRADツール、CodeGear Delphi (RAD Studio)に関する主に自分用のメモ書きです。