2008年10月28日

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日開催です。

2008年10月24日

Microsoft OOB Update 2008/10

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

2008年10月15日

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)

2008年10月13日

[書籍]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に買って積んだ。読む時間がほしい。

2008年10月11日

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サンプルプログラム集 ファイルの圧縮属性の変更あたり。

2008年10月10日

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

NTFSで使用することができるファイル圧縮機能をプログラムから利用する方法の第二弾です。
ファイル/フォルダの圧縮属性をセット/リセットするにはCreateFileでファイル/フォルダをオープンし、DeviceIoControlFSCTL_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サンプルプログラム集 ファイルの圧縮属性の変更あたり。

2008年10月9日

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など。

2008年10月3日

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

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

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

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