{$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93}

{$DEFINE Delphi3orHigher}

{$ENDIF} {$ENDIF} {$ENDIF}

unit ShellNotify;

interface

uses

 Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,

 {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, ComObj, {$ENDIF}

 ShlObj;



type

 NOTIFYREGISTER = record

  pidlPath : PItemIDList;

  bWatchSubtree : boolean;

end;

PNOTIFYREGISTER = ^NOTIFYREGISTER;

const

 SNM_SHELLNOTIFICATION = WM_USER +1;

 SHCNF_ACCEPT_INTERRUPTS = $0001;

 SHCNF_ACCEPT_NON_INTERRUPTS = $0002;

 SHCNF_NO_PROXY = $8000;

type

 TNotificationEvent = (neAssociationChange, neAttributesChange,

  neFileChange, neFileCreate, neFileDelete, neFileRename,

  neDriveAdd, neDriveRemove, neShellDriveAdd, neDriveSpaceChange,

  neMediaInsert, neMediaRemove, neFolderCreate, neFolderDelete,

  neFolderRename, neFolderUpdate, neNetShare, neNetUnShare,

  neServerDisconnect, neImageListChange);

 TNotificationEvents = set of TNotificationEvent;

 TShellNotificationEvent1 = procedure(Sender: TObject;

  Path: string)of object;

 TShellNotificationEvent2 = procedure(Sender: TObject;

  path1, path2: string) of object;

 // TShellNotificationAttributesEvent = procedure(Sender: TObject;

 // OldAttribs, NewAttribs: Integer) of Object;

 TShellNotification = class( TComponent )

  private

  fWatchEvents: TNotificationEvents;

  fPath: string;

  fActive, fWatch: Boolean;

  prevPath1, prevPath2: string;

  PrevEvent: Integer;

  Handle, NotifyHandle: HWND;

  fOnAssociationChange: TNotifyEvent;

  fOnAttribChange: TShellNotificationEvent2;

  FOnCreate: TShellNotificationEvent1;

  FOnDelete: TShellNotificationEvent1;

  FOnDriveAdd: TShellNotificationEvent1;

  FOnDriveAddGui: TShellNotificationEvent1;

  FOnDriveRemove: TShellNotificationEvent1;

  FOnMediaInsert: TShellNotificationEvent1;

  FOnMediaRemove: TShellNotificationEvent1;

  FOnDirCreate: TShellNotificationEvent1;

  FOnNetShare: TShellNotificationEvent1;

  FOnNetUnShare: TShellNotificationEvent1;

  FOnRenameFolder: TShellNotificationEvent2;

  FOnItemRename: TShellNotificationEvent2;

  FOnFolderRemove: TShellNotificationEvent1;

  FOnServerDisconnect: TShellNotificationEvent1;

  FOnFolderUpdate: TShellNotificationEvent1;

  function PathFromPidl(Pidl: PItemIDList): string;

  procedure SetWatchEvents(const Value: TNotificationEvents);

  function GetActive: Boolean;

  procedure SetActive(const Value: Boolean);

  procedure SetPath(const Value: string);

  procedure SetWatch(const Value: Boolean);

  protected

  procedure ShellNotifyRegister;

  procedure ShellNotifyUnregister;

  procedure WndProc(var message: TMessage);

  procedure DoAssociationChange; dynamic;

  procedure DoAttributesChange(Path1, Path2: string); dynamic;

  procedure DoCreateFile(Path: string); dynamic;

  procedure DoDeleteFile(Path: string); dynamic;

  procedure DoDriveAdd(Path:string); dynamic;

  procedure DoDriveAddGui(Path: string); dynamic;

  procedure DoDriveRemove(Path: string); dynamic;

  procedure DoMediaInsert(Path: string); dynamic;

  procedure DoMediaRemove(Path: string); dynamic;

  procedure DoDirCreate(Path: string); dynamic;

  procedure DoNetShare(Path: string); dynamic;

  procedure DoNetUnShare(Path: string); dynamic;

  procedure DoRenameFolder(Path1, Path2: string); dynamic;

  procedure DoRenameItem(Path1, Path2: string); dynamic;

  procedure DoFolderRemove(Path: string); dynamic;

  procedure DoServerDisconnect(Path: string); dynamic;

  procedure DoDirUpdate(Path: string); dynamic;

  public

  constructor Create(AOwner: TComponent); override;

  destructor Destroy; override;

  published

  property Path: string read fPath write SetPath;

  property Active: Boolean read GetActive write SetActive;

  property WatchSubTree: Boolean read fWatch write SetWatch;

  property WatchEvents: TNotificationEvents

  read fWatchEvents write SetWatchEvents;

  property OnAssociationChange: TNotifyEvent

  read fOnAssociationChange write FOnAssociationChange;

  property OnAttributesChange: TShellNotificationEvent2

  read fOnAttribChange write fOnAttribChange;

  property OnFileCreate: TShellNotificationEvent1

  read FOnCreate write FOnCreate;

  property OnFolderRename: TShellNotificationEvent2

  read FOnRenameFolder write FOnRenameFolder;

  property OnFolderUpdate: TShellNotificationEvent1

  read FOnFolderUpdate write FOnFolderUpdate;

  property OnFileDelete: TShellNotificationEvent1

  read FOnDelete write FOnDelete;

  property OnDriveAdd: TShellNotificationEvent1

  read FOnDriveAdd write FOnDriveAdd;

  property OnFolderRemove: TShellNotificationEvent1

  read FOnFolderRemove write FOnFolderRemove;

  property OnItemRename: TShellNotificationEvent2

  read FOnItemRename write FOnItemRename;

  property OnDriveAddGui: TShellNotificationEvent1

  read FOnDriveAddGui write FOnDriveAddGui;

  property OnDriveRemove: TShellNotificationEvent1

  read FOnDriveRemove write FOnDriveRemove;

  property OnMediaInserted: TShellNotificationEvent1

  read FOnMediaInsert write FOnMediaInsert;

  property OnMediaRemove: TShellNotificationEvent1

  read FOnMediaRemove write FOnMediaRemove;

  property OnDirCreate: TShellNotificationEvent1

  read FOnDirCreate write FOnDirCreate;

  property OnNetShare: TShellNotificationEvent1

  read FOnNetShare write FOnNetShare;

  property OnNetUnShare: TShellNotificationEvent1

  read FOnNetUnShare write FOnNetUnShare;

  property OnServerDisconnect: TShellNotificationEvent1

  read FOnServerDisconnect write FOnServerDisconnect;

end;

function SHChangeNotifyRegister( hWnd: HWND; dwFlags: integer;

wEventMask : cardinal; uMsg: UINT; cItems : integer;

lpItems : PNOTIFYREGISTER) : HWND; stdcall;

function SHChangeNotifyDeregister(hWnd: HWND) : boolean; stdcall;

function SHILCreateFromPath(Path: Pointer; PIDL: PItemIDList;

var Attributes: ULONG):HResult; stdcall;

implementation

const Shell32DLL = 'shell32.dll';

function SHChangeNotifyRegister; external Shell32DLL index 2;

function SHChangeNotifyDeregister; external Shell32DLL index 4;

function SHILCreateFromPath; external Shell32DLL index 28;

{ TShellNotification }

constructor TShellNotification.Create(AOwner: TComponent);

begin

 inherited Create( AOwner );

 if not (csDesigning in ComponentState) then

  Handle := AllocateHWnd(WndProc);

end;

destructor TShellNotification.Destroy;

begin

 if not (csDesigning in ComponentState) then

  Active := False;

 if Handle <> 0 then

  DeallocateHWnd( Handle );

 inherited Destroy;

end;

procedure TShellNotification.DoAssociationChange;

begin

 if Assigned( fOnAssociationChange ) and

 (neAssociationChange in fWatchEvents) then

  fOnAssociationChange( Self );

end;

procedure TShellNotification.DoAttributesChange;

begin

 if Assigned( fOnAttribChange ) then

  fOnAttribChange( Self, Path1, Path2 );

end;

procedure TShellNotification.DoCreateFile(Path: string);

begin

 if Assigned( fOnCreate ) then

  FOnCreate(Self, Path)

end;

procedure TShellNotification.DoDeleteFile(Path: string);

begin

 if Assigned( FOnDelete ) then

  FOnDelete(Self, Path);

end;

procedure TShellNotification.DoDirCreate(Path: string);

begin

 if Assigned( FOnDirCreate ) then

  FOnDirCreate( Self, Path );

end;

procedure TShellNotification.DoDirUpdate(Path: string);

begin

 if Assigned( FOnFolderUpdate ) then

  FOnFolderUpdate(Self, Path);

end;

procedure TShellNotification.DoDriveAdd(Path: string);

begin

 if Assigned( FOnDriveAdd ) then

  FOnDriveAdd(Self, Path);

end;

procedure TShellNotification.DoDriveAddGui(Path: string);

begin

 if Assigned( FOnDriveAddGui ) then

  FOnDriveAdd(Self, Path);

end;

procedure TShellNotification.DoDriveRemove(Path: string);

begin

 if Assigned( FOnDriveRemove ) then

  FOnDriveRemove(Self, Path);

end;

procedure TShellNotification.DoFolderRemove(Path: string);

begin

 if Assigned(FOnFolderRemove) then

  FOnFolderRemove( Self, Path );

end;

procedure TShellNotification.DoMediaInsert(Path: string);

begin

 if Assigned( FOnMediaInsert ) then

  FOnMediaInsert(Self, Path);

end;

procedure TShellNotification.DoMediaRemove(Path: string);

begin

 if Assigned(FOnMediaRemove) then

  FOnMediaRemove(Self, Path);

end;

procedure TShellNotification.DoNetShare(Path: string);

begin

 if Assigned(FOnNetShare) then

  FOnNetShare(Self, Path);

end;

procedure TShellNotification.DoNetUnShare(Path: string);

begin

 if Assigned(FOnNetUnShare) then

  FOnNetUnShare(Self, Path);

end;

procedure TShellNotification.DoRenameFolder(Path1, Path2: string);

begin

 if Assigned( FOnRenameFolder ) then

  FOnRenameFolder(Self, Path1, Path2);

end;

procedure TShellNotification.DoRenameItem(Path1, Path2: string);

begin

 if Assigned( FOnItemRename ) then

  FonItemRename(Self, Path1, Path2);

end;

procedure TShellNotification.DoServerDisconnect(Path: string);

begin

 if Assigned( FOnServerDisconnect ) then

  FOnServerDisconnect(Self, Path);

end;

function TShellNotification.GetActive: Boolean;

begin

 Result := (NotifyHandle <> 0) and (fActive);

end;

function TShellNotification.PathFromPidl(Pidl: PItemIDList): string;

begin

 SetLength(Result, Max_Path);

 if not SHGetPathFromIDList(Pidl, PChar(Result)) then

  Result := '';

 if pos(#0, Result) > 0 then

  SetLength(Result, pos(#0, Result));

end;

procedure TShellNotification.SetActive(const Value: Boolean);

begin

 if (Value <> fActive) then

 begin

  fActive := Value;

  if fActive then

  ShellNotifyRegister

  else

  ShellNotifyUnregister;

 end;

end;

procedure TShellNotification.SetPath(const Value: string);

begin

 if fPath <> Value then

 begin

  fPath := Value;

  ShellNotifyRegister;

 end;

end;

procedure TShellNotification.SetWatch(const Value: Boolean);

begin

 if fWatch <> Value then

 begin

  fWatch := Value;

  ShellNotifyRegister;

 end;

end;

procedure TShellNotification.SetWatchEvents(

const Value: TNotificationEvents);

begin

 if fWatchEvents <> Value then

 begin

  fWatchEvents := Value;

  ShellNotifyRegister;

 end;

end;

procedure TShellNotification.ShellNotifyRegister;

var

 NotifyRecord: PNOTIFYREGISTER;

 Flags: DWORD;

 Pidl: PItemIDList;

 Attributes: ULONG;

begin

 if not (csDesigning in ComponentState) and

 not (csLoading in ComponentState) then

 begin

  SHILCreatefromPath( PChar(fPath), Addr(Pidl), Attributes);

  NotifyRecord^.pidlPath := Pidl;

  NotifyRecord^.bWatchSubtree := fWatch;

  if NotifyHandle <> 0 then

  ShellNotifyUnregister;

  Flags := 0;

  if neAssociationChange in FWatchEvents then

  Flags := Flags or SHCNE_ASSOCCHANGED;

  if neAttributesChange in FWatchEvents then

  Flags := Flags or SHCNE_ATTRIBUTES;

  if neFileChange in FWatchEvents then

  Flags := Flags or SHCNE_UPDATEITEM;

  if neFileCreate in FWatchEvents then

  Flags := Flags or SHCNE_CREATE;

  if neFileDelete in FWatchEvents then

  Flags := Flags or SHCNE_DELETE;

  if neFileRename in FWatchEvents then

  Flags := Flags or SHCNE_RENAMEITEM;

  if neDriveAdd in FWatchEvents then

  Flags := Flags or SHCNE_DRIVEADD;

  if neDriveRemove in FWatchEvents then

  Flags := Flags or SHCNE_DRIVEREMOVED;

  if neShellDriveAdd in FWatchEvents then

  Flags := Flags or SHCNE_DRIVEADDGUI;

  if neDriveSpaceChange in FWatchEvents then

  Flags := Flags or SHCNE_FREESPACE;

  if neMediaInsert in FWatchEvents then

  Flags := Flags or SHCNE_MEDIAINSERTED;

  if neMediaRemove in FWatchEvents then

  Flags := Flags or SHCNE_MEDIAREMOVED;

  if neFolderCreate in FWatchEvents then

  Flags := Flags or SHCNE_MKDIR;

  if neFolderDelete in FWatchEvents then

  Flags := Flags or SHCNE_RMDIR;

  if neFolderRename in FWatchEvents then

  Flags := Flags or SHCNE_RENAMEFOLDER;

  if neFolderUpdate in FWatchEvents then

  Flags := Flags or SHCNE_UPDATEDIR;

  if neNetShare in FWatchEvents then

  Flags := Flags or SHCNE_NETSHARE;

  if neNetUnShare in FWatchEvents then

  Flags := Flags or SHCNE_NETUNSHARE;

  if neServerDisconnect in FWatchEvents then

  Flags := Flags or SHCNE_SERVERDISCONNECT;

  if neImageListChange in FWatchEvents then

  Flags := Flags or SHCNE_UPDATEIMAGE;

  NotifyHandle := SHChangeNotifyRegister(Handle,

  SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,

  Flags, SNM_SHELLNOTIFICATION, 1, NotifyRecord);

 end;

end;

procedure TShellNotification.ShellNotifyUnregister;

begin

 if NotifyHandle <> 0 then

  SHChangeNotifyDeregister(NotifyHandle);

end;

procedure TShellNotification.WndProc(var message: TMessage);

type

 TPIDLLIST = record

 pidlist : array[1..2] of PITEMIDLIST;

end;

PIDARRAY = ^TPIDLLIST;

var

 Path1 : string;

 Path2 : string;

 ptr : PIDARRAY;

 repeated : boolean;

 event : longint;

begin

 case message.Msg of

  SNM_SHELLNOTIFICATION:

  begin

  event := message.LParam and ($7FFFFFFF);

  Ptr := PIDARRAY(message.WParam);

  Path1 := PathFromPidl( Ptr^.pidlist[1] );

  Path2 := PathFromPidl( Ptr^.pidList[2] );

  repeated := (PrevEvent = event)

  and (uppercase(prevpath1) = uppercase(Path1))

  and (uppercase(prevpath2) = uppercase(Path2));

  if Repeated then

  exit;

  PrevEvent := message.Msg;

  prevPath1 := Path1;

  prevPath2 := Path2;

  case event of

  SHCNE_ASSOCCHANGED : DoAssociationChange;

  SHCNE_ATTRIBUTES : DoAttributesChange( Path1, Path2);

  SHCNE_CREATE : DoCreateFile(Path1);

  SHCNE_DELETE : DoDeleteFile(Path1);

  SHCNE_DRIVEADD : DoDriveAdd(Path1);

  SHCNE_DRIVEADDGUI : DoDriveAddGui(path1);

  SHCNE_DRIVEREMOVED : DoDriveRemove(Path1);

  SHCNE_MEDIAINSERTED : DoMediaInsert(Path1);

  SHCNE_MEDIAREMOVED : DoMediaRemove(Path1);

  SHCNE_MKDIR : DoDirCreate(Path1);

  SHCNE_NETSHARE : DoNetShare(Path1);

  SHCNE_NETUNSHARE : DoNetUnShare(Path1);

  SHCNE_RENAMEFOLDER : DoRenameFolder(Path1, Path2);

  SHCNE_RENAMEITEM : DoRenameItem(Path1, Path2);

  SHCNE_RMDIR : DoFolderRemove(Path1);

  SHCNE_SERVERDISCONNECT : DoServerDisconnect(Path);

  SHCNE_UPDATEDIR : DoDirUpdate(Path);

  SHCNE_UPDATEIMAGE : ;

  SHCNE_UPDATEITEM : ;

  end;

  end;

 end;

end;

end.