Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年11月06日] [更新 2014年06月01日] Delphi サンプルプログラム集
   
815_フォルダの監視コンポーネント
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
その他の動作確認環境については,本文参照
815_FolderWatcher.zip [597 KB] 2014年06月01日版(EXE同梱)



  • 2010年11月25日
  • ILFree を CoTaskMemFree に変更 (MSDN の記事による)
  • 2010年11月27日
  • GetDispNameFromPItemID 関数の修正 (Unicode 対応になっていなかった)
  • 2010年12月02日
  • Windows 2000 でも使用可能にした
  • 2010年12月24日
  • SHCNE_UPDATEDIR イベントが続けて発生した際,検出できない現象を修正
  • 2011年01月10日
  • 複数のコンポを使用した場合に,有効なインスタンスが 1 つだけになってしまう現象を修正 (オーナーのサブクラス関数のコードを修正)
  • 2011年01月11日
  • 複数のコンポを使用した場合に,イベントが同時に発生してしまう現象を修正
  • この修正によって,StartWatch の引数を廃止 (引数の意味がなくなったので)
  • 2014年06月01日
  • 記事の整備と,リンクとコード内のコメント類の修正.コンポのソースコードの変更はなし




フォルダ監視コンポーネント


指定したフォルダ内のフォルダ,ファイルの変更を監視するためのコンポーネントです,特殊フォルダ内も監視できます.シェル関数の SHChangeNotifyRegister 関数を使用しています.

ディレクトリ変更の検出は,FindFirstChangeNotification 関数と FindNextChangeNotification 関数の組み合わせでも可能です.また,ReadDirectoryChangesW という関数もあります.これらの関数ではファイルサイズや変更日付を直接取得することができます.
逆に,シェルの変更をシステムに通知したり,システムのシェル関係の変更をシステムに反映させるには,SHChangeNotify 関数を使用します.このフォルダ監視コンポーネントは,SHChangeNotify 関数が発行する変更イベントを検出しますが,全てではありません.

本記事掲載の 2010年11月06日時点で,以下の環境で動作確認をしています.
  • Windows XP(SP3) + Delphi 6, 7, 2007, 2009, 2010, XE 全て Pro 版
  • Windows Vista + Delphi 2007, 2010 全て Pro 版
  • Windows 7 U64 + Delphi 2010 Pro
Delphi 2007 以前の Delphi でコンパイルすれば,作成した EXE が Windows 2000 でも動作することも確認しています.





01_インストール・使用方法・仕様


添付の plFolderWatcher.pas をコンポーネントしてインストール (登録) します.コンポーネントのアイコンは用意していません.以下の手順で使用します.
  • (1) コンポーネントをコントロールに配置
  • (2) 監視するフォルダを Directory プロパティに指定
  • (3) StartWatch メソッドを実行
  • (4) OnChange イベント内で,発生したイベントを検出して処理する
  • (5) 監視を終了する時は StopWatch を実行
特殊フォルダ内の監視もできますから,例えばプリンタの追加,削除も検出可能です.CD-ROM や DVD のディスクの挿入等は検出できません.USB や SD ドライブの挿入等は検出できるようです.

監視フォルダをデスクトップにすれば,デスクトップ以下全てのイベントを検出できますが,ネットワーク上のコンピュータ内の変更の検出はできない場合があります.システムの割り込み制御によるイベントは検出しません.内部的にフラグを設定していません.

削除や貼り付けのファイル数が多い場合は,対象ファイル名の全てを取得することはできません.フォルダー内の変化の SHCNE_UPDATEDIR となります.これは使用している API の仕様によるものです. OnChange イベント内で,他の API 関数を使用して調査することも可能と思われますが,その処理に時間がかかると,更にイベントが発生したり,次の変更イベントの処理が正常に行われないことも考えられます.注意してください.

オプションの設定によって,どのようなイベントがどんな内容で検出できるかを確認するための,テストするプログラムを添付しています.十分確認して利用してください.




02_プロパティ


プロパティは,監視するフォルダの指定と,監視内容の設定があります.


図1
オブジェクト・インスペクタ

表1
プロパティ

凡例  published
 public
 ReadOnly

 Directory String 監視対象のフォルダ (ディレクトリ)
空の場合はデスクトップ
特殊フォルダや仮想フォルダはフルパスに変換するか,GUID 文字列に変換して代入する
 Recursive Boolean サブフォルダ内も監視するかのフラグ
True なら監視,False なら監視しない
監視対象がデスクトップの場合は False にしても無効
 Options - 検出するイベントの種類の指定.下表の値の組み合わせ
これらのオプションの値は,SHCNE_RENAMEITEM 等の先頭を
evt_ に置き換えたものになっている


下の表は,設定可能な Options プロパティの値です.OnChange イベントで,これらのフラグを検出することになります.詳細はリンクの MSDN の記事を参考にしてください.


表2
Options プロパティの値

要素 監視・検出内容
evt_RENAMEITEM 非フォルダの名前の変化
SHCNE_RENAMEITEM を検出する.以下同様
evt_CREATE 非フォルダの作成
evt_DELETE 非フォルダの削除
削除数が多い場合は,SHCNE_UPDATEDIR も発生
evt_MKDIR フォルダの作成
evt_RMDIR フォルダの削除
削除数が多い場合は,SHCNE_UPDATEDIR も発生
evt_MEDIAINSERTED 記憶媒体のドライブ挿入
evt_MEDIAREMOVED ドライブからの記憶媒体の取り除き
evt_DRIVEADD ドライブ追加
evt_NETSHARE ローカルコンピュータの上のフォルダーかネットワークの共有開始
evt_NETUNSHARE ローカルコンピュータの上のフォルダーの共有解除
evt_ATTRIBUTES フォルダーか非フォルダの属性変化
evt_UPDATEDIR フォルダーの内容変化.フォルダーはまだ存在していて名前は変更されていない
evt_UPDATEITEM フォルダーか非フォルダーの変化.それはまだ存在していて名前の変更はない
evt_ATTRIBUTES 項目かフォルダの属性変化
evt_SERVERDISCONNECT コンピュータのサーバからの切断
evt_UPDATEIMAGE システムイメージリストのイメージの変化
evt_DRIVEADDGUI Windows XP 以降では未使用のフラグ
evt_RENAMEFOLDER フォルダーの名前変更
evt_FREESPACE ドライブの空き容量の量の変化
evt_ASSOCCHANGED ファイルの種類変化
evt_DISKEVENTS ディスクイベントの全ての組み合わせ
evt_GLOBALEVENTS グローバルな現象の全ての組み合わせ
evt_ALLEVENTS 全てのイベントの組み合わせ




03_メソッド


監視の開始と終了のメソッドがあります.


function StartWatch:Boolean

監視を開始します.監視対象のフォルダを Directory プロパティに設定して,StartWatch メソッドを実行すると,新しいフォルダの監視に移行します.前のフォルダの監視は自動的に終了します.
複数のフォルダの同時監視はできません.監視フォルダをデスクトップにして,OnChange イベント内で変更のあったパス名を判定して処理すれば可能です.


procedure StopWatch

監視を終了します.




04_イベント


以下のイベントがあります.


OnChange(Sender,
         AEvent,
         BeforeFullPath,
         BeforeFileName,
         AfterFullPath,
         AfterFileName)

このイベントで,発生した変更イベントを検出します.取得可能なイベントはオプションプロパティで設定した内容です.イベントの種類を取得するには uses に ShlObj が必要です.

取得フォルダ,ファイル名は,Options の値,監視するフォルダによっても違ってきます.フォルダ内のファイルを削除または移動した際は,主に SHCNE_RENAMEITEM が発生しますが,対象ファイル数が多いと,SHCNE_UPDATEDIR も,あるいは,SHCNE_UPDATEDIR だけが発生する場合もあります.貼り付けの場合も同じです.

おそらく,変更があったファイル名の検出には適していないと思われます.全てのファイル名を検出するのであれば,別の方法を考える必要があるかも知れません.


引数 説明
Sender TObject コンポーネント自身
AEvent Integer 発生したイベントの種類
Options に evt_RENAMEITEM があれば SHCNE_RENAMEITEM を検出
Options に evt_DELETE があれば SHCNE_DELETE を検出
以下,同様
BeforeFullPath String 変更前のファイルまたはフォルダのフルパス
BeforeFileName String 変更前のファイルまたはフォルダの名前
AfterFullPath String 変更後のファイルまたはフォルダのフルパス
イベントの種類によっては空文字の場合がある
AfterFileName String 変更後のファイルまたはフォルダの名前
イベントの種類によっては空文字の場合がある




05_テストプログラム


どんなオプションでどんな変更イベントが取得できるかをテストするために,画面でプロパティを設定できるようにしています.


  • 図2
  • 設計時画面
  • 特殊 (仮想) フォルダもテストしたいので,拙作 TplBrowseFolder コンポを使用
  • 特殊 (仮想) フォルダを選択可能にするには,TplBrowseFolder のプロパティの変更が必要


  • 図3
  • 実行例.監視フォルダは [マイコンピュータ]
  • D:\TEST\AAA というフォルダの名前を変更
  • BB2.txt と BB1.txt というファイルを削除
  • 新規にテキストファイルを作成
  • ドライブ F:\ にデジタルカメラ用の SD ディクスを挿入
  • これらの表示内容は Options の値と監視フォルダによって異なる

リスト1
フォルダ監視コンポーネントのテストプログラム
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, plFileDialog, plFolderWatcher, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    plBrowseFolder1: TplBrowseFolder;
    ListView1: TListView;
    plFolderWatcher1: TplFolderWatcher;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    CheckBox12: TCheckBox;
    CheckBox13: TCheckBox;
    CheckBox14: TCheckBox;
    CheckBox15: TCheckBox;
    CheckBox16: TCheckBox;
    CheckBox17: TCheckBox;
    CheckBox18: TCheckBox;
    CheckBox19: TCheckBox;
    CheckBox20: TCheckBox;
    CheckBox21: TCheckBox;
    CheckBox22: TCheckBox;
    CheckBox23: TCheckBox;
    CheckBox100: TCheckBox;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure plFolderWatcher1Change(Sender: TObject; AEvent: Integer;
      BeforeFullPath, BeforeFileName, AfterFullPath, AfterFileName: string);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox100Click(Sender: TObject);
  private
    { Private 宣言 }
    BaseDir  : String;
    ShowFlag : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShlObj;

{$R *.dfm}

//=============================================================================
//  初期監視フォルダをこのプロジェクトのあるフォルダに
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  ACol : TListColumn;
begin
  ShowFlag := False;
  BaseDir  := ExtractFilePath(Application.ExeName);

  //結果表示用のリストビューの設定
  ListView1.ViewStyle := vsReport;

  ACol := ListView1.Columns.Add;
  ACol.Width   := 100;
  ACol.Caption := 'イベント';

  ACol := ListView1.Columns.Add;
  ACol.Width := 200;
  ACol.Caption := '変更前';

  ACol := ListView1.Columns.Add;
  ACol.Width := 200;
  ACol.Caption := '変更後';

  //チェックボックスに現在のオプションの設定を反映
  CheckBox1.Checked  := evt_RENAMEITEM       in plFolderWatcher1.Options;
  CheckBox2.Checked  := evt_CREATE           in plFolderWatcher1.Options;
  CheckBox3.Checked  := evt_DELETE           in plFolderWatcher1.Options;
  CheckBox4.Checked  := evt_MKDIR            in plFolderWatcher1.Options;
  CheckBox5.Checked  := evt_RMDIR            in plFolderWatcher1.Options;
  CheckBox6.Checked  := evt_MEDIAINSERTED    in plFolderWatcher1.Options;
  CheckBox7.Checked  := evt_MEDIAREMOVED     in plFolderWatcher1.Options;
  CheckBox8.Checked  := evt_DRIVEREMOVED     in plFolderWatcher1.Options;
  CheckBox9.Checked  := evt_DRIVEADD         in plFolderWatcher1.Options;
  CheckBox10.Checked := evt_NETSHARE         in plFolderWatcher1.Options;
  CheckBox11.Checked := evt_NETUNSHARE       in plFolderWatcher1.Options;
  CheckBox12.Checked := evt_ATTRIBUTES       in plFolderWatcher1.Options;
  CheckBox13.Checked := evt_UPDATEDIR        in plFolderWatcher1.Options;
  CheckBox14.Checked := evt_UPDATEITEM       in plFolderWatcher1.Options;
  CheckBox15.Checked := evt_SERVERDISCONNECT in plFolderWatcher1.Options;
  CheckBox16.Checked := evt_UPDATEIMAGE      in plFolderWatcher1.Options;
  CheckBox17.Checked := evt_DRIVEADDGUI      in plFolderWatcher1.Options;
  CheckBox18.Checked := evt_RENAMEFOLDER     in plFolderWatcher1.Options;
  CheckBox19.Checked := evt_FREESPACE        in plFolderWatcher1.Options;
  CheckBox20.Checked := evt_ASSOCCHANGED     in plFolderWatcher1.Options;
  CheckBox21.Checked := evt_DISKEVENTS       in plFolderWatcher1.Options;
  CheckBox22.Checked := evt_GLOBALEVENTS     in plFolderWatcher1.Options;
  CheckBox23.Checked := evt_ALLEVENTS        in plFolderWatcher1.Options;

  CheckBox100.Checked := plFolderWatcher1.Recursive;

  ShowFlag := True;
end;

//=============================================================================
//  [デスクトップ以下全て]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  plFolderWatcher1.Directory := '';
  plFolderWatcher1.StartWatch;
end;

//=============================================================================
//  [監視フォルダ指定]ボタン
//  フォルダの選択ダイアログで監視するフォルダを設定して監視開始
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  //操作対象のフォルダ指定
  plBrowseFolder1.InitDir := BaseDir;
  if plBrowseFolder1.Execute then begin
    BaseDir := plBrowseFolder1.Directory;

    plFolderWatcher1.Directory := plBrowseFolder1.Directory;
    plFolderWatcher1.StartWatch;
  end;
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  plFolderWatcher1.StopWatch;
end;

//=============================================================================
//  チェックボックスのチェックを変更したらOptionsの値も変更
//  全てのチェックボックス共用イベント
//  監視中の変更はできない
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
var
  Options : TplFolderEventOptions;
begin
  if ShowFlag = False then exit;

  Options := [];
  if CheckBox1.Checked  then Options := Options + [evt_RENAMEITEM];
  if CheckBox2.Checked  then Options := Options + [evt_CREATE];
  if CheckBox3.Checked  then Options := Options + [evt_DELETE];
  if CheckBox4.Checked  then Options := Options + [evt_MKDIR];
  if CheckBox5.Checked  then Options := Options + [evt_RMDIR];
  if CheckBox6.Checked  then Options := Options + [evt_MEDIAINSERTED];
  if CheckBox7.Checked  then Options := Options + [evt_MEDIAREMOVED];
  if CheckBox8.Checked  then Options := Options + [evt_DRIVEREMOVED];
  if CheckBox9.Checked  then Options := Options + [evt_DRIVEADD];
  if CheckBox10.Checked then Options := Options + [evt_NETSHARE];
  if CheckBox11.Checked then Options := Options + [evt_NETUNSHARE];
  if CheckBox12.Checked then Options := Options + [evt_ATTRIBUTES];
  if CheckBox13.Checked then Options := Options + [evt_UPDATEDIR];
  if CheckBox14.Checked then Options := Options + [evt_UPDATEITEM];
  if CheckBox15.Checked then Options := Options + [evt_SERVERDISCONNECT];
  if CheckBox16.Checked then Options := Options + [evt_UPDATEIMAGE];
  if CheckBox17.Checked then Options := Options + [evt_DRIVEADDGUI];
  if CheckBox18.Checked then Options := Options + [evt_RENAMEFOLDER];
  if CheckBox19.Checked then Options := Options + [evt_FREESPACE];
  if CheckBox20.Checked then Options := Options + [evt_ASSOCCHANGED];
  if CheckBox21.Checked then Options := Options + [evt_DISKEVENTS];
  if CheckBox22.Checked then Options := Options + [evt_GLOBALEVENTS];
  if CheckBox23.Checked then Options := Options + [evt_ALLEVENTS];

  plFolderWatcher1.Options := Options;
end;

//=============================================================================
//  [Recursive]チェックボックス
//  サブフォルダも監視するかのプロパティであるが,デスクトップの場合は無効
//  通常のフォルダの場合は有効なようである
//=============================================================================
procedure TForm1.CheckBox100Click(Sender: TObject);
begin
  if ShowFlag = False then exit;

  plFolderWatcher1.Recursive := CheckBox100.Checked;
end;

//=============================================================================
//  フォルダ監視コンポーネントのOnChageイベント
//  SHCNE_RENAMEITEM等の定数値を使用するにはusesにShlObjが必要
//=============================================================================
procedure TForm1.plFolderWatcher1Change(Sender: TObject; AEvent: Integer;
  BeforeFullPath, BeforeFileName, AfterFullPath, AfterFileName: string);
var
  ACaption : String;
  AItem    : TListItem;
begin
  ACaption := '';
  case AEvent of
    SHCNE_RENAMEITEM       : ACaption := 'RENAMITEM';
    SHCNE_CREATE           : ACaption := 'CREATE';
    SHCNE_DELETE           : ACaption := 'DELETE';
    SHCNE_MKDIR            : ACaption := 'MKDIR';
    SHCNE_RMDIR            : ACaption := 'RMDIR';
    SHCNE_MEDIAINSERTED    : ACaption := 'MEDIAINSERTED';
    SHCNE_MEDIAREMOVED     : ACaption := 'MEDIAREMOVED';
    SHCNE_DRIVEREMOVED     : ACaption := 'DRIVEREMOVED';
    SHCNE_DRIVEADD         : ACaption := 'DRIVEADD';
    SHCNE_NETSHARE         : ACaption := 'NETSHARE';
    SHCNE_NETUNSHARE       : ACaption := 'NETUNSHARE';
    SHCNE_ATTRIBUTES       : ACaption := 'ATTRIBUTES';
    SHCNE_UPDATEDIR        : ACaption := 'UPDATEDIR';
    SHCNE_UPDATEITEM       : ACaption := 'UPDATEITEM';
    SHCNE_SERVERDISCONNECT : ACaption := 'SERVERDISCONNECT';
    SHCNE_UPDATEIMAGE      : ACaption := 'UPDATEIMAGE';
    SHCNE_DRIVEADDGUI      : ACaption := 'DRIVEADDGUI';
    SHCNE_RENAMEFOLDER     : ACaption := 'RENAMEFOLDER';
    SHCNE_FREESPACE        : ACaption := 'FREESPACE';
    SHCNE_ASSOCCHANGED     : ACaption := 'ASSOCCHANGED';
    SHCNE_DISKEVENTS       : ACaption := 'DISKEVENTS';
  end;

  AItem := ListView1.Items.Add;
  AItem.Caption := ACaption;
  AItem.SubItems.Add(BeforeFullPath);
  AItem.SubItems.Add(AfterFullPath);

  //最終行が見えるようにする
  if ListView1.Items.Count > 0 then begin
    ListView1.Items[ListView1.Items.Count - 1].MakeVisible(True);
  end;
end;

end.




06_コンポーネントのソースコード


コンポーネントのソースコードです.使用している関数類の動作については,本ページ内の参考リンクの記事を参考にして下さい.

このコンポーネントは,SHChangeNotify 関数が発行するメッセージを受け取りますが,このコンポーネントは非ビジュアルコンポーネントです.メッセージを受信するウィンドウがありません.
そこで,非可視のウィンドウ (実際には表示しない隠しウィンドウ) を,AllocateHWnd 関数で生成しています.このウィンドウでメッセージを受信します.

フォルダの監視を開始する SHChangeNotifyRegister 関数の最後の引数は,TSHChangeNotifyEntry 構造体となっています.この構造体のメンバーに,監視するフォルダを項目識別子で指定します.
実フォルダを項目識別子に変換する関数に,ILCreateFromPath がありますが,この関数は,仮想フォルダは項目識別子に変換してくれません (GUID 文字列で与えれば変換します).また,Delphi 2010 以上でないと使用できません.そこで,専用の関数を作成して使用しています.

受信したメッセージのフォルダやファイル名は項目識別子です.項目識別子を実際のフォルダやファイル名に変換する関数に SHGetPathFromIDList がありますが,これも仮想フォルダは変換してくれません.そこで,専用の関数を作成して変換するようにしています.



リスト2
フォルダ監視コンポーネントのソースコード
unit plFolderWatcher;

interface

uses
  SysUtils, Classes, ActiveX, Forms, Messages, ShlObj, Windows, Controls;

var
  WM_PLCHANGENOTIFY : Cardinal;

type
  //監視イベントの種類の要素
  TplFolderEventOption = (
    evt_RENAMEITEM,
    evt_CREATE,
    evt_DELETE,
    evt_MKDIR,
    evt_RMDIR,
    evt_MEDIAINSERTED,
    evt_MEDIAREMOVED,
    evt_DRIVEREMOVED,
    evt_DRIVEADD,
    evt_NETSHARE,
    evt_NETUNSHARE,
    evt_ATTRIBUTES,
    evt_UPDATEDIR,
    evt_UPDATEITEM,
    evt_SERVERDISCONNECT,
    evt_UPDATEIMAGE,
    evt_DRIVEADDGUI,
    evt_RENAMEFOLDER,
    evt_FREESPACE,
    evt_ASSOCCHANGED,
    evt_DISKEVENTS,
    evt_GLOBALEVENTS,
    evt_ALLEVENTS);

  TplFolderEventOptions = set of TplFolderEventOption;
  TplFolderWatcherEvent = procedure(Sender: TObject;
                                    AEvent: Integer;
                                    BeforeFullPath, BeforeFileName: String;
                                    AfterFullPath, AfterFileName: String) of object;

  TplFolderWatcher = class(TComponent)
  private
    { Private 宣言 }
    uIID       : Cardinal;
    FAboutVCL  : String;
    FSources   : Integer;
    FDirectory : String;
    FRecursive : Boolean;
    FOptions   : TplFolderEventOptions;
    FOnChange  : TplFolderWatcherEvent;

    FWindowHandle     : HWND;
    FsfDesktop        : IShellFolder;
    FOldPathBefore    : String;
    FOldPathAfter     : String;
    FOldEvent         : Integer;

    procedure WndProc(var msg: TMessage);
  protected
    { Protected 宣言 }
    Malloc : IMalloc;
    property Sources : Integer read FSources write FSources;
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function StartWatch: Boolean;
    procedure StopWatch;
  published
    { Published 宣言 }
    property AboutVCL  : String                read FAboutVCL;
    property Directory : String                read FDirectory write FDirectory;
    property Recursive : Boolean               read FRecursive write FRecursive;
    property Options   : TplFolderEventOptions read FOptions   write FOptions;
    property OnChange  : TplFolderWatcherEvent read FOnChange  write FOnChange;
  end;

{$IF CompilerVersion < 21.0}
//-----------------------------------------------------------------------------
//  Delphi 2010よりも前のバージョンではShlObj.pasに定義がない関数がある
//  そこで,その対応策として,ここで定義
//
//  これらの関数類はWindows 2000以降のShell32.dllで提供されている
//  Windows 2000では,これらの関数は非公開APIとなっている
//  非公開APIはinterface部で関数定義をし,implementation部でexternalする
//  そうすれば使用可能となる.ただし,序数の指定が必要
//-----------------------------------------------------------------------------
const
  SHCNRF_InterruptLevel     = $00000001;
  SHCNRF_ShellLevel         = $00000002;
  SHCNRF_RecursiveInterrupt = $00001000;

type
  _SHChangeNotifyEntry = record
    pidl: PItemIDList;
    fRecursive: BOOL;
  end;
  SHChangeNotifyEntry  = _SHChangeNotifyEntry;
  TSHChangeNotifyEntry = SHChangeNotifyEntry;
  PSHChangeNotifyEntry = ^TSHChangeNotifyEntry;

  function ILClone(pidl: PItemIDList): PItemIDList; stdcall;
  function SHChangeNotifyRegister(hwnd: HWND;
                                  fSources: Integer;
                                  fEvents: Integer;
                                  wMsg: UINT;
                                  cEntries: Integer;
                                  var pshcne: TSHChangeNotifyEntry): ULONG; stdcall;
  function SHChangeNotifyDeregister(ulID: LongWord): BOOL; stdcall;
//-----------------------------------------------------------------------------
{$IFEND}

procedure Register;

implementation

const
  FolderEventOptions : array [TplFolderEventOption] of Integer = (
    SHCNE_RENAMEITEM,
    SHCNE_CREATE,
    SHCNE_DELETE,
    SHCNE_MKDIR,
    SHCNE_RMDIR,
    SHCNE_MEDIAINSERTED,
    SHCNE_MEDIAREMOVED,
    SHCNE_DRIVEREMOVED,
    SHCNE_DRIVEADD,
    SHCNE_NETSHARE,
    SHCNE_NETUNSHARE,
    SHCNE_ATTRIBUTES,
    SHCNE_UPDATEDIR,
    SHCNE_UPDATEITEM,
    SHCNE_SERVERDISCONNECT,
    SHCNE_UPDATEIMAGE,
    SHCNE_DRIVEADDGUI,
    SHCNE_RENAMEFOLDER,
    SHCNE_FREESPACE,
    SHCNE_ASSOCCHANGED,
    SHCNE_DISKEVENTS,
    SHCNE_GLOBALEVENTS,
    SHCNE_ALLEVENTS);

  {$IF CompilerVersion < 21.0}
  Shell32DLL = 'shell32.dll';
  function ILClone; external Shell32DLL index 18;
  function SHChangeNotifyRegister; external Shell32DLL index 2;
  function SHChangeNotifyDeregister; external Shell32DLL index 4;
  {$IFEND}

//-----------------------------------------------------------------------------
//  項目識別子からフォルダまたはファイルの表示名を求める
//
//  第1引数  対象の項目識別子を取得する際に使用したシェルフォルダオブジェクト
//  第2引数  対象の項目識別子
//-----------------------------------------------------------------------------
function GetDispNameFromPItemID(ShFolder: IShellFolder; ItemID: PItemIDList;
   Flag: DWORD=SHGDN_NORMAL): String;
var
  StrRet : TStrRet;
begin
  Result := '';
  if ShFolder = nil then exit;
  if ItemID = nil then exit;

  FillChar(StrRet, SizeOf(StrRet), 0);
  if NOERROR = ShFolder.GetDisplayNameOf(ItemID, Flag, StrRet) then begin
    case StrRet.uType of
    STRRET_CSTR:
      begin
        SetString(Result, StrRet.cStr, Length(StrRet.cStr));
      end;
    STRRET_OFFSET:
      begin
        //ポインタのオフセット
        Inc(pByte(ItemID), StrRet.uOffset);
        Result := PChar(ItemID);
      end;
    STRRET_WSTR:
      begin
        Result := StrRet.pOleStr;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ファイル名を項目識別子に変換する関数
//-----------------------------------------------------------------------------
function GetPItemIDFromFileName(ShFolder:IShellFolder; Path:String): PItemIDList;
var
  Len   : Cardinal;
  Flags : Cardinal;
begin
  Flags := 0;
  Len   := Length(Path);
  ShFolder.ParseDisplayName(Application.Handle,
                            nil,
                            PWideChar(StringToOleStr(Path)),
                            Len,
                            Result,
                            Flags);
end;

{ TplFolderWatcher }

//=============================================================================
//  受取ったメッセージの処理
//  本コンポのオーナーのウィンドウサブクラスプロシージャー
//
//  単にOSが発行するメッセージの値をOnChangeの引数に渡しているだけ
//  このコードではEventという変数
//=============================================================================
procedure TplFolderWatcher.WndProc(var msg: TMessage);
type
  TPItemIDListArray = array of PItemIDList;
  PPItemIDListArray  = TPItemIDListArray;

var
  PItemIDBefore : PItemIDList;
  PItemIDAfter  : PItemIDList;
  PathBefore    : String;
  PathAfter     : String;
  Event         : Integer;
begin
  if msg.Msg = WM_PLCHANGENOTIFY then begin

    //メッセージの種類
    Event := msg.LParam;

    //変更前のファイルフォルダの項目識子(デスクトップ基準)
    //PItemIDs[0]には処理したファイルの名前が,[1]は操作の種類によって異なる
    PItemIDBefore := ILClone(TPItemIDListArray(msg.WParam)[0]);

    //変更後のファイルフォルダの項目識別子(デスクトップ基準)
    PItemIDAfter := ILClone(TPItemIDListArray(msg.WParam)[1]);

    //それらの項目識別子をフルパスに変換
    PathBefore := GetDispNameFromPItemID(FsfDesktop, PItemIDBefore, SHGDN_FORPARSING);
    PathAfter  := GetDispNameFromPItemID(FsfDesktop, PItemIDAfter,  SHGDN_FORPARSING);

    if (FOldEvent      = Event)      and
       (FOldPathBefore = PathBefore) and
       (FOldPathAfter  = PathAfter)  then begin
       //ファイルやフォルダ名の変更等は同じイベントが2回以上くることがある
       //イベントや名前が前とおなじだった場合はOnChangeイベントに送らない
    end else begin
      FOldEvent      := Event;
      FOldPathBefore := PathBefore;
      FOldPathAfter  := PathAfter;

      if Assigned(FOnChange) then begin
        FOnChange(Self,
                  Event,
                  PathBefore,
                  ExtractFileName(PathBefore),
                  PathAfter,
                  ExtractFileName(PathAfter));
      end;
    end;
    if FOldEvent = SHCNE_UPDATEDIR then FOldEvent := -1;

    CoTaskMemFree (PItemIDBefore);
    CoTaskMemFree (PItemIDAfter);
  end else begin
    Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  end;
end;

//=============================================================================
//  Create処理
//=============================================================================
constructor TplFolderWatcher.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  //Delphi 6,7ではオブジェクトインスペクタに表示されない
  FAboutVCL := 'Version 1.05';

  FOptions := [evt_RENAMEITEM,
               evt_CREATE,
               evt_DELETE,
               evt_MKDIR,
               evt_RMDIR,
               evt_UPDATEDIR,
               evt_UPDATEITEM,
               evt_RENAMEFOLDER];
  FRecursive    := True;
  FWindowHandle := 0;
end;

//=============================================================================
//  終了処理
//=============================================================================
destructor TplFolderWatcher.Destroy;
begin
  StopWatch;
  inherited Destroy;
end;

//=============================================================================
//  フォルダの監視を開始(公開メソッド)
//=============================================================================
function TplFolderWatcher.StartWatch: Boolean;
var
  ADirectory  : String;
  PItemID     : PItemIDList;
  Entry       : TSHChangeNotifyEntry;
  fEvents     : Integer;
  OptionValue : TplFolderEventOption;
begin
  Result := False;
  StopWatch;
  if Failed(SHGetMalloc(Malloc)) then exit;
  if Failed(SHGetDesktopFolder(FsfDesktop)) then exit;

  if WM_PLCHANGENOTIFY = 0 then begin
    WM_PLCHANGENOTIFY := RegisterWindowMessage('wm_plchangenotify');
  end;

  //監視フォルダの項目識別子を取得
  //これはデスクトップ基準からの値
  if FDirectory = '' then begin
    if Failed(SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, PItemID)) then exit;
  end else begin
    ADirectory := IncludeTrailingPathDelimiter(FDirectory);
    //ドライブレターかどうかを判定
    //GetPItemIDFromFileNameに渡す値は,ドライブの場合はデリミタが必要.それ以
    //外はデリミタを削除する
    if ADirectory <> ExtractFileDir(ADirectory) then begin
      ADirectory := ExcludeTrailingPathDelimiter(FDirectory);
    end;
    PItemID := GetPItemIDFromFileName(FsfDesktop, ADirectory);
  end;

  Entry.pidl       := PItemID;
  Entry.fRecursive := FRecursive;
  if FRecursive then begin
    FSources := SHCNRF_ShellLevel or
                SHCNRF_InterruptLevel or
                SHCNRF_RecursiveInterrupt;
  end else begin
    FSources := SHCNRF_ShellLevel or
                SHCNRF_InterruptLevel;
  end;

  //オプションの設定
  fEvents := 0;
  for OptionValue := Low(OptionValue) to High(OptionValue) do begin
    if OptionValue in FOptions then begin
      fEvents := fEvents or FolderEventOptions[OptionValue];
    end;
  end;

  //メッセージを受信するために隠しウィンドウを生成
  if FWindowHandle = 0 then begin
    FWindowHandle := AllocateHWnd(WndProc);

    //監視開始
    uIID := SHChangeNotifyRegister(FWindowHandle,
                                   FSources,
                                   fEvents,
                                   WM_PLCHANGENOTIFY,
                                   1,
                                   Entry);
    Result := uIID <> 0;
  end;

  CoTaskMemFree(PItemID);
end;

//=============================================================================
//  フォルダの監視を終了(公開メソッド)
//  uIID : SHChangeNotifyRegister関数の戻り値を与える
//         複数のフォルダを指定した場合は,複数あるので全てこの値を指定して
//         監視を終了する(ただし,本コンポでは複数フォルダ監視はしていない)
//=============================================================================
procedure TplFolderWatcher.StopWatch;
begin
  //AllocateHWnd を使って作成されたウィンドウを解放
  DeallocateHWnd(FWindowHandle);
  FWindowHandle     := 0;
  WM_PLCHANGENOTIFY := 0;

  if uIID <> 0 then SHChangeNotifyDeregister(uIID);
  Malloc := nil;
end;

//=============================================================================
//  コンポーネント登録情報
//=============================================================================
procedure Register;
begin
  RegisterComponents('plXRAY', [TplFolderWatcher]);
end;

end.