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で管理者権限を要求するため、管理者として実行する必要があります。